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