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