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.Compta
  10  , module Hcompta.LCC.Sym.Date
  11  , module Hcompta.LCC.Sym.FileSystem
  12  , module Hcompta.LCC.Sym.Journal
  13  , module Hcompta.LCC.Sym.Negable
  14  , module Hcompta.LCC.Sym.Posting
  15  , module Hcompta.LCC.Sym.Quantity
  16  , module Hcompta.LCC.Sym.Subable
  17  , module Hcompta.LCC.Sym.Transaction
  18  , module Hcompta.LCC.Sym.Unit
  19  , module Hcompta.LCC.Sym.Zipper
  20  ) where
  21
  22 import Hcompta.LCC.Sym.Account
  23 import Hcompta.LCC.Sym.Addable
  24 import Hcompta.LCC.Sym.Amount
  25 import Hcompta.LCC.Sym.Compta
  26 import Hcompta.LCC.Sym.Date
  27 import Hcompta.LCC.Sym.FileSystem
  28 import Hcompta.LCC.Sym.Journal
  29 import Hcompta.LCC.Sym.Negable
  30 import Hcompta.LCC.Sym.Posting
  31 import Hcompta.LCC.Sym.Quantity
  32 import Hcompta.LCC.Sym.Subable
  33 import Hcompta.LCC.Sym.Transaction
  34 import Hcompta.LCC.Sym.Unit
  35 import Hcompta.LCC.Sym.Zipper
  36
  37 import Hcompta.LCC.Account (Account)
  38 import Hcompta.LCC.Amount (Amounts, Quantity, Unit)
  39 import Hcompta.LCC.Journal (Journal, PathFile)
  40 import Hcompta.LCC.Compta (Compta)
  41 import Hcompta.LCC.Posting (Posting, Date)
  42 import Hcompta.LCC.Transaction (Transaction)
  43 import Hcompta.Quantity (Addable, Negable, Subable)
  44
  45 import Control.Applicative (Alternative)
  46 import Data.Bool (Bool)
  47 import Data.Either (Either(..))
  48 import Data.Eq (Eq)
  49 import Data.Foldable (Foldable)
  50 import Data.Map.Strict (Map)
  51 import Data.Maybe (Maybe)
  52 import Data.NonNull (NonNull)
  53 import Data.Ord (Ord)
  54 import Data.Proxy
  55 import Data.Traversable (Traversable)
  56 import Data.TreeMap.Strict.Zipper (Zipper)
  57 import Text.Show (Show)
  58
  59 {-
  60 import Hcompta.LCC.Grammar
  61 import Hcompta.LCC.Journal
  62 import Hcompta.LCC.Read
  63 import Language.Symantic.Grammar
  64 import qualified Text.Megaparsec as P
  65 import qualified Data.Strict as S
  66 import System.IO (IO)
  67 import Prelude hiding (read, readFile)
  68 -}
  69
  70 type SS =
  71  [ Proxy Account
  72  , Proxy Addable
  73  , Proxy Alternative
  74  , Proxy Amounts
  75  , Proxy (->)
  76  , Proxy Bool
  77  , Proxy Date
  78  , Proxy Either
  79  , Proxy Eq
  80  , Proxy Foldable
  81  , Proxy Journal
  82  , Proxy Map
  83  , Proxy Maybe
  84  , Proxy Negable
  85  , Proxy NonNull
  86  , Proxy Ord
  87  , Proxy PathFile
  88  , Proxy Posting
  89  , Proxy Quantity
  90  , Proxy Show
  91  , Proxy Subable
  92  , Proxy Transaction
  93  , Proxy Traversable
  94  , Proxy Unit
  95  , Proxy Zipper
  96  -- , Proxy (Compta () (SymsFix FixSS))
  97  ]
  98
  99
 100 {-
 101 data Error_App cs
 102  =   Error_App_not_applicable
 103  |   Error_App_type_mismatch (Sym.EType cs) (Sym.EType cs)
 104  deriving (Eq, Show)
 105
 106 app
 107  :: Sym.Inj_TyConst cs (->)
 108  => Sym.ETermClosed cs is
 109  -> Sym.ETermClosed cs is
 110  -> Either (Error_App cs) (Sym.ETermClosed cs is)
 111 app (Sym.ETermClosed ty_f (Sym.TermClosed te_f))
 112     (Sym.ETermClosed ty_a (Sym.TermClosed te_a)) =
 113         case ty_f of
 114          ty_fun Sym.:$ ty_arg Sym.:$ ty_res
 115           | Just Refl <- Sym.kind_of ty_fun `Sym.eq_skind` (Sym.kind::Sym.SKind (Kind.Type -> Kind.Type -> Kind.Type))
 116           , Just Refl <- ty_fun `Sym.eq_Type` Sym.ty @(->) ->
 117                 case ty_arg `Sym.eq_Type` ty_a of
 118                  Just Refl -> Right $ Sym.ETermClosed ty_res $ Sym.TermClosed $ te_f Sym..$ te_a
 119                  Nothing -> Left $ Error_App_type_mismatch (Sym.EType ty_arg) (Sym.EType ty_a)
 120          _ -> Left $ Error_App_not_applicable
 121 feed_args :: Sym.TermAVT src -> [Sym.TermAVT src] -> Sym.TermAVT src
 122 feed_args te as = go te as
 123         where
 124         go f [] = f
 125         go f (x:xs) =
 126                 case f `app` x of
 127                  Right f' -> f' `go` as
 128                  Left _err -> f `go` xs
 129 -}
 130 {-
 131 type SRC = ()
 132 x0 ::
 133  IO ( ( Either (P.ParseError Char P.Dec)
 134                  (S.Either [At SRC (Error_Compta SRC)] (CanonFile, Journal [Transaction]))
 135         , Context_Read SRC [Transaction] )
 136       , Context_Sym SRC SS )
 137 x0 = readJournal @SS "./Hcompta/LCC/Journal/02.jnl" (:)
 138
 139 y0
 140  -- :: CF (P.ParsecT P.Dec Text m) a
 141  :: ( m ~ S.StateT (Context_Read j) (S.StateT (Context_Sym cs is) IO)
 142     , is ~ Ifaces
 143     , cs ~ Sym.TyConsts_of_Ifaces is
 144     -- , e ~ P.ParseError Char P.Dec
 145     )
 146  => CF (P.ParsecT P.Dec Text m)
 147        ( Sym.Term_Name
 148        , Either (At (Sym.Error_Term Meta cs is))
 149                 (Sym.ETerm cs is) )
 150 y0 = g_term
 151 -}