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 -}