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