lcc/Hcompta/LCC/Sym.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3 -- | Symantics.
   4 module Hcompta.LCC.Sym
   5  ( module Hcompta.LCC.Sym
   6  , module Hcompta.LCC.Sym.Account
   7  , module Hcompta.LCC.Sym.Addable
   8  , module Hcompta.LCC.Sym.Amount
   9  -- , module Hcompta.LCC.Sym.Balance
  10  , module Hcompta.LCC.Sym.Chart
  11  -- , module Hcompta.LCC.Sym.Code
  12  -- , module Hcompta.LCC.Sym.Compta
  13  , module Hcompta.LCC.Sym.Date
  14  , module Hcompta.LCC.Sym.FileSystem
  15  , module Hcompta.LCC.Sym.Journal
  16  , module Hcompta.LCC.Sym.LCC
  17  , module Hcompta.LCC.Sym.Negable
  18  , module Hcompta.LCC.Sym.Posting
  19  , module Hcompta.LCC.Sym.Quantity
  20  , module Hcompta.LCC.Sym.Subable
  21  , module Hcompta.LCC.Sym.Sumable
  22  , module Hcompta.LCC.Sym.Transaction
  23  , module Hcompta.LCC.Sym.Unit
  24  , module Hcompta.LCC.Sym.Writeable
  25  , module Hcompta.LCC.Sym.Zeroable
  26  , module Hcompta.LCC.Sym.Zipper
  27  ) where
  28
  29 import Language.Symantic (type (++))
  30 import qualified Language.Symantic     as Sym
  31 import qualified Language.Symantic.Lib as Sym
  32
  33 import Hcompta.LCC.Sym.Account
  34 import Hcompta.LCC.Sym.Addable
  35 import Hcompta.LCC.Sym.Amount
  36 -- import Hcompta.LCC.Sym.Balance
  37 import Hcompta.LCC.Sym.Chart
  38 -- import Hcompta.LCC.Sym.Compta
  39 -- import Hcompta.LCC.Sym.Code
  40 import Hcompta.LCC.Sym.Date
  41 import Hcompta.LCC.Sym.FileSystem
  42 import Hcompta.LCC.Sym.Journal
  43 import Hcompta.LCC.Sym.LCC
  44 import Hcompta.LCC.Sym.Negable
  45 import Hcompta.LCC.Sym.Posting
  46 import Hcompta.LCC.Sym.Quantity
  47 import Hcompta.LCC.Sym.Subable
  48 import Hcompta.LCC.Sym.Sumable
  49 import Hcompta.LCC.Sym.Transaction
  50 import Hcompta.LCC.Sym.Writeable
  51 import Hcompta.LCC.Sym.Unit
  52 import Hcompta.LCC.Sym.Zeroable
  53 import Hcompta.LCC.Sym.Zipper
  54
  55 import qualified Hcompta.LCC.Account as LCC
  56 import qualified Hcompta.LCC.Amount as LCC
  57 -- import qualified Hcompta.LCC.Balance as LCC
  58 import qualified Hcompta.LCC.Chart as LCC
  59 import qualified Hcompta.LCC.Compta as LCC
  60 import qualified Hcompta.LCC.IO as LCC
  61 import qualified Hcompta.LCC.Journal as LCC
  62 import qualified Hcompta.LCC.Posting as LCC
  63 import qualified Hcompta.LCC.Source as LCC
  64 import qualified Hcompta.LCC.Transaction as LCC
  65 import Hcompta.LCC.Write
  66 import qualified Hcompta as H
  67
  68 import Control.Applicative (Applicative, Alternative)
  69 import Control.Monad (Monad)
  70 import Data.Bool (Bool)
  71 import Data.Either (Either(..))
  72 import Data.Eq (Eq)
  73 import Data.Foldable (Foldable)
  74 import Data.Functor (Functor)
  75 import Data.Map.Strict (Map)
  76 import Data.Maybe (Maybe)
  77 import Data.MonoTraversable (MonoFunctor, MonoFoldable)
  78 import Data.Monoid (Monoid)
  79 import Data.NonNull (NonNull)
  80 import Data.Ord (Ord)
  81 import Data.Proxy
  82 import Data.Semigroup (Semigroup)
  83 import Data.Sequences (SemiSequence, IsSequence)
  84 import Data.Text (Text)
  85 import Data.Traversable (Traversable)
  86 import Data.TreeMap.Strict.Zipper (Zipper)
  87 import Prelude (Integer)
  88 import System.IO (IO)
  89 import Text.Show (Show)
  90
  91 type SS  = {-Proxy (LCC.Code SRC SS') ':-} SS'
  92 type SRC = Sym.SrcTe LCC.SourcePath SS'
  93
  94 type SS' =
  95  [ Proxy (->)
  96  , Proxy (,)
  97  , Proxy Alternative
  98  , Proxy Applicative
  99  , Proxy Bool
 100  , Proxy Either
 101  , Proxy Eq
 102  , Proxy Foldable
 103  , Proxy Functor
 104  , Proxy H.Addable
 105  , Proxy H.Negable
 106  , Proxy H.Subable
 107  , Proxy H.Zeroable
 108  , Proxy H.Sumable
 109  , Proxy IO
 110  , Proxy IsSequence
 111  , Proxy LCC.Account
 112  , Proxy LCC.Amounts
 113  -- , Proxy LCC.Balance
 114  , Proxy LCC.Chart
 115  , Proxy LCC.Date
 116  , Proxy (LCC.Journal LCC.SourceRead)
 117  , Proxy LCC.PathFile
 118  , Proxy (LCC.Posting LCC.SourceRead)
 119  , Proxy LCC.Quantity
 120  , Proxy (LCC.Transaction LCC.SourceRead)
 121  , Proxy LCC.Unit
 122  , Proxy Map
 123  , Proxy Maybe
 124  , Proxy MonoFoldable
 125  , Proxy MonoFunctor
 126  , Proxy Monad
 127  , Proxy Monoid
 128  , Proxy NonNull
 129  , Proxy Ord
 130  , Proxy Semigroup
 131  , Proxy SemiSequence
 132  , Proxy Show
 133  , Proxy Traversable
 134  , Proxy Writeable
 135  , Proxy Zipper
 136  , Proxy (LCC.LCC LCC.SourceRead)
 137  ]
 138
 139 type CS =
 140  [ Proxy Sym.Element
 141  , Proxy Integer
 142  , Proxy Text
 143  , Proxy IO
 144  ] ++ SS
 145
 146 {-
 147 data Error_App cs
 148  =   Error_App_not_applicable
 149  |   Error_App_type_mismatch (Sym.EType cs) (Sym.EType cs)
 150  deriving (Eq, Show)
 151
 152 app
 153  :: Sym.Inj_TyConst cs (->)
 154  => Sym.ETermClosed cs is
 155  -> Sym.ETermClosed cs is
 156  -> Either (Error_App cs) (Sym.ETermClosed cs is)
 157 app (Sym.ETermClosed ty_f (Sym.TermClosed te_f))
 158     (Sym.ETermClosed ty_a (Sym.TermClosed te_a)) =
 159         case ty_f of
 160          ty_fun Sym.:$ ty_arg Sym.:$ ty_res
 161           | Just Refl <- Sym.kind_of ty_fun `Sym.eq_skind` (Sym.kind::Sym.SKind (Kind.Type -> Kind.Type -> Kind.Type))
 162           , Just Refl <- ty_fun `Sym.eq_Type` Sym.ty @(->) ->
 163                 case ty_arg `Sym.eq_Type` ty_a of
 164                  Just Refl -> Right $ Sym.ETermClosed ty_res $ Sym.TermClosed $ te_f Sym..$ te_a
 165                  Nothing -> Left $ Error_App_type_mismatch (Sym.EType ty_arg) (Sym.EType ty_a)
 166          _ -> Left $ Error_App_not_applicable
 167 feed_args :: Sym.TermAVT src -> [Sym.TermAVT src] -> Sym.TermAVT src
 168 feed_args te as = go te as
 169         where
 170         go f [] = f
 171         go f (x:xs) =
 172                 case f `app` x of
 173                  Right f' -> f' `go` as
 174                  Left _err -> f `go` xs
 175 -}
 176 {-
 177 type SRC = ()
 178 x0 ::
 179  IO ( ( Either (P.ParseError Char P.Dec)
 180                  (S.Either [At SRC (Error_Compta SRC)] (CanonFile, Journal [Transaction]))
 181         , Context_Read SRC [Transaction] )
 182       , Context_Sym SRC SS )
 183 x0 = readJournal @SS "./Hcompta/LCC/Journal/02.jnl" (:)
 184
 185 y0
 186  -- :: CF (P.ParsecT P.Dec Text m) a
 187  :: ( m ~ S.StateT (Context_Read j) (S.StateT (Context_Sym cs is) IO)
 188     , is ~ Ifaces
 189     , cs ~ Sym.TyConsts_of_Ifaces is
 190     -- , e ~ P.ParseError Char P.Dec
 191     )
 192  => CF (P.ParsecT P.Dec Text m)
 193        ( Sym.Term_Name
 194        , Either (At (Sym.Error_Term Meta cs is))
 195                 (Sym.ETerm cs is) )
 196 y0 = g_term
 197 -}