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