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