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