{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
-- import qualified Control.Monad.Classes as MC
import Control.Monad (Monad(..), forM_)
+import Data.Bool (Bool(..))
import Data.Char (Char)
import Data.Either (Either(..))
import Data.Either (either)
import Data.Eq (Eq)
import Data.Function (($), (.), id)
-import Data.Maybe (Maybe(..))
+import Data.Functor ((<$>))
+import Data.Maybe (Maybe(..), maybe)
+import qualified Data.List as L
import Data.Semigroup ((<>))
import Data.Text (Text)
import System.IO (IO, putStrLn)
import Text.Show (Show(..))
+import qualified System.IO as IO
+import qualified Data.Map.Strict as Map
import qualified Control.Monad.Trans.State.Strict as SS
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified System.Environment as Env
import qualified Text.Megaparsec as P
+import qualified Data.Text as T
+import qualified Data.Char as Char
-import Language.Symantic.Grammar
+import qualified Language.Symantic.Grammar as G
import Language.Symantic as Sym
import qualified Language.Symantic.Lib as Sym
+import qualified Language.Symantic.Document as D
-- import qualified Hcompta.LCC as LCC
import qualified Hcompta.LCC.Sym as LCC.Sym
import Control.Applicative (Applicative(..))
import Data.Functor (Functor(..))
import Data.Functor.Identity (Identity(..))
-import Data.Proxy (Proxy(..))
import qualified Control.Monad.Classes.Run as MC
import Prelude (error)
main :: IO ()
main = do
args <- Env.getArgs
+ let mods::Modules SRC SS =
+ either (error . show) id $
+ Sym.deleteDefTermInfix ([] `Mod` "$") `fmap`
+ inj_Modules
+ (`D.ansiIO` IO.stderr) $ docModules mods
forM_ args $ \arg -> do
- ast <- printError $ parseTe @SS @SRC (Text.pack arg)
+ ast <- printError $ parseTe mods (Text.pack arg)
te <- printError $ readTe ast
evalTe te
printError (Left err) = error $ show err
printError (Right a) = return a
+docModules ::
+ Source src =>
+ D.Doc_Text d =>
+ D.Doc_Color d =>
+ D.Doc_Decoration d =>
+ ReadTe src ss =>
+ Sym.Modules src ss -> d
+docModules (Sym.Modules mods) =
+ Map.foldrWithKey
+ (\p m doc -> docModule p m <> doc)
+ D.empty
+ mods
+
+docModule ::
+ forall src ss d.
+ Source src =>
+ D.Doc_Text d =>
+ D.Doc_Color d =>
+ D.Doc_Decoration d =>
+ ReadTe src ss =>
+ Sym.PathMod -> Sym.Module src ss -> d
+docModule m Sym.Module
+ { Sym.module_infix
+ , Sym.module_prefix
+ , Sym.module_postfix
+ } =
+ go docFixityInfix module_infix <>
+ go docFixityPrefix module_prefix <>
+ go docFixityPostfix module_postfix
+ where
+ go :: (fixy -> d) -> ModuleFixy src ss fixy -> d
+ go docFixy =
+ Map.foldrWithKey
+ (\n Sym.Tokenizer
+ { Sym.token_fixity
+ , Sym.token_term = t
+ } doc ->
+ docPathTe m n <>
+ docFixy token_fixity <>
+ D.space <> D.bold (D.yellower "::") <> D.space <>
+ docTokenTerm (t Sym.noSource) <>
+ D.eol <> doc)
+ D.empty
+
+docTokenTerm ::
+ forall src ss d.
+ Source src =>
+ D.Doc_Text d =>
+ D.Doc_Color d =>
+ ReadTe src ss =>
+ Sym.Token_Term src ss -> d
+docTokenTerm t =
+ let n2t = inj_Name2Type @ss in
+ case Sym.readTerm n2t CtxTyZ (G.BinTree0 t) of
+ Right (Sym.TermVT te) ->
+ Sym.docType Sym.config_doc_type
+ { config_Doc_Type_vars_numbering = False
+ } 0 $ Sym.typeOfTerm te
+
+docFixityInfix :: (D.Doc_Decoration t, D.Doc_Color t, D.Doc_Text t) => Infix -> t
+docFixityInfix = \case
+ Sym.Infix Nothing 5 -> D.empty
+ Sym.Infix a p ->
+ let docAssoc = \case
+ Sym.AssocL -> "l"
+ Sym.AssocR -> "r"
+ Sym.AssocB Sym.SideL -> "l"
+ Sym.AssocB Sym.SideR -> "r" in
+ D.magenta $ " infix" <> maybe D.empty docAssoc a <>
+ D.space <> D.bold (D.bluer (D.int p))
+docFixityPrefix :: (D.Doc_Decoration t, D.Doc_Color t, D.Doc_Text t) => Unifix -> t
+docFixityPrefix (Sym.Prefix p) = D.magenta $ " prefix " <> D.bold (D.bluer (D.int p))
+docFixityPostfix :: (D.Doc_Decoration t, D.Doc_Color t, D.Doc_Text t) => Unifix -> t
+docFixityPostfix (Sym.Postfix p) = D.magenta $ " postfix " <> D.bold (D.bluer (D.int p))
+
+docPathMod :: D.Doc_Text d => PathMod -> d
+docPathMod (p::Sym.PathMod) =
+ D.catH $
+ L.intersperse (D.charH '.') $
+ (\(Sym.NameMod n) -> D.textH n) <$> p
+
+docPathTe ::
+ D.Doc_Text d =>
+ D.Doc_Color d =>
+ Sym.PathMod -> Sym.NameTe -> d
+docPathTe (ms::Sym.PathMod) (Sym.NameTe n) =
+ D.catH $
+ L.intersperse (D.charH '.') $
+ ((\(Sym.NameMod m) -> D.textH m) <$> ms) <>
+ [(if isOp n then id else D.yellower) $ D.text n]
+ where
+ isOp = T.all $ \case '_' -> True; '\'' -> True; c -> Char.isAlphaNum c
+
+
+
parseTe ::
- forall ss src.
- Inj_Modules src ss =>
Gram_Term src ss (P.ParsecT P.Dec Text (SS.StateT (Sym.Imports, Modules src ss) Identity)) =>
+ Sym.Modules src ss ->
Text ->
Either (P.ParseError Char P.Dec) (AST_Term src ss)
-parseTe inp =
- let mods::Modules src ss =
- either (error . show) id $
- Sym.deleteDefTermInfix ([] `Mod` "$") `fmap`
- inj_Modules in
+parseTe mods inp =
let imps = importQualifiedAs [] mods in
fmap reduceTeApp $
runIdentity $
MC.evalStateStrict (imps, mods) $
P.runParserT g "" inp
where
- g = unCF $ g_term <* eoi
+ g = G.unCF $ Sym.g_term <* G.eoi
+
+type ReadTe src ss =
+ ( Gram_Term src ss (P.ParsecT P.Dec Text (SS.StateT (Sym.Imports, Modules src ss) Identity))
+ , Inj_Modules src ss
+ , Inj_Name2Type ss
+ , Inj_Source (TypeVT src) src
+ , Inj_Source (TypeT src '[]) src
+ , Inj_Source (KindK src) src
+ , Inj_Source (AST_Type src) src
+ )
readTe ::
forall src ss.
AST_Term src ss ->
Either (Error_Term src) (TermVT src ss '[])
readTe ast =
- let tys = inj_Name2Type (Proxy @ss) in
- Sym.readTerm tys CtxTyZ ast
+ let n2t = inj_Name2Type @ss in
+ Sym.readTerm n2t CtxTyZ ast
evalTe ::
Source src =>
import Data.Monoid (Monoid(..))
import Data.NonNull (NonNull)
import Data.Ord (Ord(..))
-import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Text (Text)
, context_read_journals :: !(Journals j)
, context_read_journal :: !(NonEmpty (Journal j))
, context_read_canonfiles :: !(NonEmpty CanonFile)
- , context_read_warnings :: ![At src Warning_Journal]
+ , context_read_warnings :: ![At src Warning_Compta]
, context_read_section :: !Section
} deriving (Eq, Show)
Context_Sym
{ context_sym_imports = Sym.importQualifiedAs [] mods
, context_sym_modules = mods
- , context_sym_name2type = Sym.inj_Name2Type (Proxy @ss)
+ , context_sym_name2type = Sym.inj_Name2Type @ss
, context_sym_env = Map.empty
, context_sym_terms = Map.empty
}
-- * Class 'Gram_IO'
class Gram_Source src g => Gram_IO src g where
g_read
- :: g (S.Either (Error_Journal src) PathFile)
- -> g (S.Either [At src (Error_Journal src)] (CanonFile, a))
- -> g (S.Either [At src (Error_Journal src)] (CanonFile, a))
+ :: g (S.Either (Error_Compta src) PathFile)
+ -> g (S.Either [At src (Error_Compta src)] (CanonFile, a))
+ -> g (S.Either [At src (Error_Compta src)] (CanonFile, a))
deriving instance Gram_IO src g => Gram_IO src (CF g)
-- * Class 'Gram_Count'
) => Gram_Chart g where
g_chart_entry ::
Gram_Source src g =>
- CF g (S.Either (At src (Error_Journal src)) Chart)
+ CF g (S.Either (At src (Error_Compta src)) Chart)
g_chart_entry = rule "Chart" $
(\acct attrs ->
let (tags, tags2, _comments) = attrs in
<* Sym.symbol "="
<*> Sym.g_term
--- * Class 'Gram_Journal'
+-- * Class 'Gram_Compta'
class
( Gram_Source src g
, Gram_Try g
, Gram_Input g
, Monoid j
-- , Show src
- ) => Gram_Journal ss src j g where
- g_journal
+ ) => Gram_Compta ss src j g where
+ g_compta
:: (Transaction -> j -> j)
- -> CF g (S.Either [At src (Error_Journal src)]
+ -> CF g (S.Either [At src (Error_Compta src)]
(CanonFile, Journal j))
- g_journal consTxn = rule "Journal" $
+ g_compta consTxn = rule "Journal" $
g_state_after $ g_ask_before $
mk_journal
<$> (g_state_after $ g_source $ g_ask_before $ g_ask_before $ pure init_journal)
-- in order to have Megaparsec reporting the errors
-- of the included journal.
, g_state_after $ mk_transaction
- <$> g_journal_section Section_Transactions g_transaction
+ <$> g_compta_section Section_Transactions g_transaction
, g_state_after $ mk_chart
- <$> g_journal_section Section_Chart g_chart_entry
+ <$> g_compta_section Section_Chart g_chart_entry
, g_state_before $ g_state_before $ g_input $ g_source $ mk_term
- <$> g_journal_section Section_Terms g_term_def
+ <$> g_compta_section Section_Terms g_term_def
, ([], []) <$ try (g_spaces <* g_eol)
])
where
, context_read_canonfiles = cfs
}::Context_Read src j) =
case lr_cf of
- S.Left e -> (ctx, S.Left $ At src $ Error_Journal_Read (PathFile jf) e)
+ S.Left e -> (ctx, S.Left $ At src $ Error_Compta_Read (PathFile jf) e)
S.Right cf ->
let jnl = journal{journal_file=PathFile jf} in
(,S.Right ())
ins_term n t = Sym.insertTermVT ([] `Sym.Mod` t) n (Sym.Fixity2 Sym.infixN5)
ins_body :: Sym.NameTe -> Text -> Terms -> Terms
ins_body n t = Map.insert ([] `Sym.Mod` n) t
- warn_redef :: Sym.NameTe -> Terms -> [At src Warning_Journal]
+ warn_redef :: Sym.NameTe -> Terms -> [At src Warning_Compta]
warn_redef n ts =
case Map.lookup ([] `Sym.Mod` n) ts of
- Just{} -> [At src $ Warning_Journal_Term_redefined n]
+ Just{} -> [At src $ Warning_Compta_Term_redefined n]
Nothing -> []
g_include
:: (Transaction -> j -> j)
- -> CF g (S.Either [At src (Error_Journal src)]
+ -> CF g (S.Either [At src (Error_Compta src)]
(CanonFile, Journal j))
g_include consTxn = rule "Include" $
- g_read g_path (g_journal @ss consTxn <* eoi)
+ g_read g_path (g_compta @ss consTxn <* eoi)
where
g_path =
g_state_after $ g_source $ check_path
, context_read_warnings = warns
}::Context_Read src j) =
case lr_cf of
- Left e -> (ctx, S.Left $ Error_Journal_Read fp e)
+ Left e -> (ctx, S.Left $ Error_Compta_Read fp e)
Right cf ->
if cf `Map.member` js
then
if cf `elem` cfs
- then (ctx, S.Left $ Error_Journal_Include_loop cf)
+ then (ctx, S.Left $ Error_Compta_Include_loop cf)
else
(,S.Right fp) $
if isJust $ (`L.find` warns) $ \case
- At{unAt=Warning_Journal_Include_multiple cf'} -> cf' `elem` cf<|cfs
+ At{unAt=Warning_Compta_Include_multiple cf'} -> cf' `elem` cf<|cfs
_ -> False
then ctx
else ctx
{ context_read_warnings =
- At src (Warning_Journal_Include_multiple cf) : warns }
+ At src (Warning_Compta_Include_multiple cf) : warns }
else (ctx, S.Right fp)
-- * Integers
| Section_Transactions
deriving (Eq, Ord, Show)
-g_journal_section ::
+g_compta_section ::
forall src err a g.
- Sym.Inj_Error err (Error_Journal src) =>
+ Sym.Inj_Error err (Error_Compta src) =>
Gram_State Section g =>
Gram_Source src g =>
Functor g =>
Section ->
g (S.Either (At src err) a) ->
- g (S.Either (At src (Error_Journal src)) a)
-g_journal_section sec g =
+ g (S.Either (At src (Error_Compta src)) a)
+g_compta_section sec g =
g_state_before $ g_source $
(\a src sec_curr ->
(sec,) $
if sec_curr <= sec
then fmap Sym.inj_Error `S.left` a
- else S.Left $ At src $ Error_Journal_Section sec_curr sec
+ else S.Left $ At src $ Error_Compta_Section sec_curr sec
) <$> g
-- * Type 'Year'
= Error_Chart
deriving (Eq, Show)
--- * Type 'Error_Journal'
-data Error_Journal src
- = Error_Journal_Transaction Error_Transaction
- | Error_Journal_Read PathFile Exn.IOException
- | Error_Journal_Include_loop CanonFile
- | Error_Journal_Chart Error_Chart
- | Error_Journal_Section Section Section
- | Error_Journal_Term Sym.NameTe (Sym.Error_Term src)
+-- * Type 'Error_Compta'
+data Error_Compta src
+ = Error_Compta_Transaction Error_Transaction
+ | Error_Compta_Read PathFile Exn.IOException
+ | Error_Compta_Include_loop CanonFile
+ | Error_Compta_Chart Error_Chart
+ | Error_Compta_Section Section Section
+ | Error_Compta_Term Sym.NameTe (Sym.Error_Term src)
deriving (Eq, Show)
-instance Sym.Inj_Error (Sym.NameTe, Sym.Error_Term src) (Error_Journal src) where
- inj_Error (n, t) = Error_Journal_Term n t
-instance Sym.Inj_Error Error_Transaction (Error_Journal src) where
- inj_Error = Error_Journal_Transaction
-instance Sym.Inj_Error (Error_Journal src) (Error_Journal src) where
+instance Sym.Inj_Error (Sym.NameTe, Sym.Error_Term src) (Error_Compta src) where
+ inj_Error (n, t) = Error_Compta_Term n t
+instance Sym.Inj_Error Error_Transaction (Error_Compta src) where
+ inj_Error = Error_Compta_Transaction
+instance Sym.Inj_Error (Error_Compta src) (Error_Compta src) where
inj_Error = id
--- * Type 'Warning_Journal'
-data Warning_Journal
- = Warning_Journal_Include_multiple CanonFile
- | Warning_Journal_Term_redefined Sym.NameTe
+-- * Type 'Warning_Compta'
+data Warning_Compta
+ = Warning_Compta_Include_multiple CanonFile
+ | Warning_Compta_Term_redefined Sym.NameTe
deriving (Eq, Show)
{-
lr <- g_source $ do
lr_path <- g_path
case lr_path of
- S.Left (e::Error_Journal src) ->
+ S.Left (e::Error_Compta src) ->
return $ \(src::src) ->
S.Left $ At src e
S.Right (PathFile fp) ->
liftIO $ Exn.catch
((\inp _src -> S.Right $ (fp,) $ Enc.decodeUtf8 inp) <$> BS.readFile fp)
- (\exn -> return $ \src -> S.Left $ At src $ Error_Journal_Read (PathFile fp) exn)
+ (\exn -> return $ \src -> S.Left $ At src $ Error_Compta_Read (PathFile fp) exn)
case lr of
S.Left e -> do
return $ S.Left [e]
P.popPosition
return lr_a
-instance -- LCC.Gram_Journal
+instance -- LCC.Gram_Compta
( ParsecC e s
, MonadIO m
, MC.MonadState (Sym.Modules src ss) m
, MC.MonadState Section (P.ParsecT e s m)
, MC.MonadState Style_Amounts (P.ParsecT e s m)
, MC.MonadState Year (P.ParsecT e s m)
- ) => Gram_Journal ss src j (P.ParsecT e s m)
+ ) => Gram_Compta ss src j (P.ParsecT e s m)
instance -- LCC.Gram_Term_Def
( ParsecC e s
-- , MC.MonadState (Env src ss) m
FilePath ->
(Transaction -> j -> j) ->
IO (( Either (P.ParseError Char P.Dec)
- (S.Either [At src (Error_Journal src)]
+ (S.Either [At src (Error_Compta src)]
(CanonFile, Journal j))
, Context_Read src j )
, Context_Sym src ss )
-readJournal path consTxn = readFile path $ read $ g_journal @ss consTxn
+readJournal path consTxn = readFile path $ read $ g_compta @ss consTxn
readCompta ::
forall src ss j g.
Sym.Inj_Modules src ss =>
FilePath ->
-- (Transaction -> j -> j) ->
- IO (Either (Error_Read src) (Compta src ss, [At src Warning_Journal]))
+ IO (Either (Error_Read src) (Compta src ss, [At src Warning_Compta]))
readCompta path = do
((r, ctxRead), ctxSym) <-
readFile path $ read $
- g_journal @ss (\t -> Map.insertWith (<>) (transaction_date t) [t])
+ g_compta @ss (\t -> Map.insertWith (<>) (transaction_date t) [t])
return $ case r of
Left err -> Left $ Error_Read_Syntax err
Right r' ->
-- * Type 'Error_Read'
data Error_Read src
= Error_Read_Syntax (P.ParseError Char P.Dec)
- | Error_Read_Semantic [At src (Error_Journal src)]
+ | Error_Read_Semantic [At src (Error_Compta src)]
deriving (Eq, Show)
{-
type SRC = ()
x0 ::
IO ( ( Either (P.ParseError Char P.Dec)
- (S.Either [At SRC (Error_Journal SRC)] (CanonFile, Journal [Transaction]))
+ (S.Either [At SRC (Error_Compta SRC)] (CanonFile, Journal [Transaction]))
, Context_Read SRC [Transaction] )
, Context_Sym SRC SS )
x0 = readJournal @SS "./Hcompta/LCC/Journal/02.jnl" (:)
, Gram_Source src g
, Inj_Sym ss Account
) => Gram_Term_AtomsFor src ss g Account where
- g_term_atomsFor _s =
+ g_term_atomsFor =
[ rule "term_account" $
lexeme $ g_source $
(\a src -> BinTree0 $ Token_Term $ TermAVT $ (`setSource` src) $ teAccount a)
Name . Text.pack
<$> some (choice $ unicat <$> [Unicat_Letter])
instance (Source src, Inj_Sym ss Account) => ModuleFor src ss Account where
- moduleFor _s = ["Account"] `moduleWhere`
+ moduleFor = ["Account"] `moduleWhere`
[
]
tyAccount :: Source src => Inj_Len vs => Type src vs Account
tyAccount = tyConst @(K Account) @Account
-teAccount :: Source src => Inj_Sym ss Account => Account -> Term src ss ts '[] Account
+teAccount :: Source src => Inj_Sym ss Account => Account -> Term src ss ts '[] (() #> Account)
teAccount a = Term noConstraint tyAccount $ teSym @Account $ account a
-- * Class 'Sym_Name'
expandFamFor _c _len _fam _as = Nothing
instance Gram_Term_AtomsFor src ss g Name
instance (Source src, Inj_Sym ss Name) => ModuleFor src ss Name where
- moduleFor _s = ["Name"] `moduleWhere`
+ moduleFor = ["Name"] `moduleWhere`
[
]
instance TypeInstancesFor Addable
instance Gram_Term_AtomsFor src ss g Addable
instance (Source src, Inj_Sym ss Addable) => ModuleFor src ss Addable where
- moduleFor _s = ["Addable"] `moduleWhere`
+ moduleFor = ["Addable"] `moduleWhere`
[ "+" `withInfixB` (SideL, 6) := teAddable_add
]
instance Gram_Term_AtomsFor meta ss g Amounts
instance (Source src, Inj_Sym ss Amounts, Inj_Sym ss Unit) => ModuleFor src ss Amounts where
- moduleFor _s = ["Amount"] `moduleWhere`
+ moduleFor = ["Amount"] `moduleWhere`
[ NameTe n `WithFixity` Fixity1 (mkFixy side 10) := mkAmount nega u
| (u, style_amount_unit_side -> S.Just side) <-
Map.toList $
LCC.unStyle_Amounts LCC.style_amounts
, let tu = H.unit_text u
- , (n, nega) <- if Text.all Char.isAlphaNum tu
+ , (n, nega) <- if isOp tu
then [(tu, False)]
else case side of
LCC.L -> [("-"<>tu, True), (tu, False), (tu<>"-", True)]
LCC.R -> [(tu, False)]
]
where
+ isOp = Text.all $ \case '_' -> True; '\'' -> True; c -> Char.isAlphaNum c
mkFixy LCC.L = Prefix
mkFixy LCC.R = Postfix
- mkAmount :: Source src => Inj_Sym ss Amounts => Bool -> Unit -> Term src ss ts '[] (Quantity -> Amounts)
+ mkAmount :: Source src => Inj_Sym ss Amounts => Bool -> Unit -> Term src ss ts '[] (() #> (Quantity -> Amounts))
mkAmount True u = Term noConstraint (tyQuantity ~> tyAmounts) $ teSym @Amounts $ lam1 $ \q -> amounts (unit u) (neg q)
mkAmount False u = Term noConstraint (tyQuantity ~> tyAmounts) $ teSym @Amounts $ lam1 $ \q -> amounts (unit u) q
tyAmounts :: Source src => Inj_Len vs => Type src vs Amounts
tyAmounts = tyConst @(K Amounts) @Amounts
-teAmount :: TermDef Amounts '[] (Unit -> Quantity -> Amounts)
+teAmount :: TermDef Amounts '[] (() #> (Unit -> Quantity -> Amounts))
teAmount = Term noConstraint (tyUnit ~> tyQuantity ~> tyAmounts) $ teSym @Amounts $ lam2 amounts
, Gram_Source src g
, Inj_Sym ss PathFile
) => Gram_Term_AtomsFor src ss g PathFile where
- g_term_atomsFor _t =
+ g_term_atomsFor =
[ rule "tePathFile" $
lexeme $ g_source $
(\a src -> BinTree0 $ Token_Term $ TermAVT $ (`setSource` src) $ tePathFile a)
g_pathfile_section :: CF g FilePath
g_pathfile_section = some (choice $ unicat <$> [Unicat_Letter, Unicat_Number])
instance (Source src, Inj_Sym ss PathFile) => ModuleFor src ss PathFile where
- moduleFor _s = ["PathFile"] `moduleWhere`
+ moduleFor = ["PathFile"] `moduleWhere`
[
]
tyPathFile :: Source src => Inj_Len vs => Type src vs PathFile
tyPathFile = tyConst @(K PathFile) @PathFile
-tePathFile :: Source src => Inj_Sym ss PathFile => PathFile -> Term src ss ts '[] PathFile
+tePathFile :: Source src => Inj_Sym ss PathFile => PathFile -> Term src ss ts '[] (() #> PathFile)
tePathFile a = Term noConstraint tyPathFile $ teSym @PathFile $ pathfile a
instance Gram_Term_AtomsFor src ss g Journal
instance (Source src, Inj_Sym ss Journal) => ModuleFor src ss Journal where
- moduleFor _s = ["Journal"] `moduleWhere`
+ moduleFor = ["Journal"] `moduleWhere`
[ "file" := teJournal_file
, "last_read_time" := teJournal_last_read_time
, "content" := teJournal_content
tyJournal :: Source src => Inj_Len vs => Type src vs a -> Type src vs (Journal a)
tyJournal a = tyConstLen @(K Journal) @Journal (lenVars a) `tyApp` a
-teJournal :: Source src => Inj_Sym ss Journal => Journal a -> Term src ss ts '[Proxy a] (Journal a)
+teJournal :: Source src => Inj_Sym ss Journal => Journal a -> Term src ss ts '[Proxy a] (() #> Journal a)
teJournal j = Term noConstraint (tyJournal a0) $ teSym @Journal $ journal j
-teJournal_file :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (Journal a -> PathFile)
+teJournal_file :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> PathFile))
teJournal_file = Term noConstraint (tyJournal a0 ~> tyPathFile) $ teSym @Journal $ lam1 journal_file
-teJournal_last_read_time :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (Journal a -> Date)
+teJournal_last_read_time :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> Date))
teJournal_last_read_time = Term noConstraint (tyJournal a0 ~> tyDate) $ teSym @Journal $ lam1 journal_last_read_time
-teJournal_content :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (Journal a -> a)
+teJournal_content :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> a))
teJournal_content = Term noConstraint (tyJournal a0 ~> a0) $ teSym @Journal $ lam1 journal_content
instance TypeInstancesFor Negable
instance Gram_Term_AtomsFor src ss g Negable
instance (Source src, Inj_Sym ss Negable) => ModuleFor src ss Negable where
- moduleFor _s = ["Negable"] `moduleWhere`
+ moduleFor = ["Negable"] `moduleWhere`
[ "-" `withPrefix` 10 := teNegable_neg
]
instance Gram_Term_AtomsFor src ss g Posting
instance (Source src, Inj_Sym ss Posting) => ModuleFor src ss Posting where
- moduleFor _s = ["Posting"] `moduleWhere`
+ moduleFor = ["Posting"] `moduleWhere`
[ "account" := tePosting_account
, "amounts" := tePosting_amounts
]
tyPosting :: Source src => Inj_Len vs => Type src vs Posting
tyPosting = tyConst @(K Posting) @Posting
-tePosting_account :: TermDef Posting '[] (Posting -> Account)
+tePosting_account :: TermDef Posting '[] (() #> (Posting -> Account))
tePosting_account = Term noConstraint (tyPosting ~> tyAccount) $ teSym @Posting $ lam1 posting_account
-tePosting_amounts :: TermDef Posting '[] (Posting -> Amounts)
+tePosting_amounts :: TermDef Posting '[] (() #> (Posting -> Amounts))
tePosting_amounts = Term noConstraint (tyPosting ~> tyAmounts) $ teSym @Posting $ lam1 posting_amounts
, Inj_Sym ss Quantity
, Source src
) => Gram_Term_AtomsFor src ss g Quantity where
- g_term_atomsFor _s =
+ g_term_atomsFor =
[ rule "teQuantity" $
lexeme $ g_source $
(\(qty, _sty) src -> BinTree0 $ Token_Term $ TermAVT $ (`setSource` src) $ teQuantity qty)
-- <*> option [] ((:) <$> char '.' <*> some (choice $ char <$> ['0'..'9']))
]
instance (Source src, Inj_Sym ss Quantity) => ModuleFor src ss Quantity where
- moduleFor _s = ["Quantity"] `moduleWhere`
+ moduleFor = ["Quantity"] `moduleWhere`
[
]
tyQuantity :: Source src => Inj_Len vs => Type src vs Quantity
tyQuantity = tyConst @(K Quantity) @Quantity
-teQuantity :: Source src => Inj_Sym ss Quantity => Quantity -> Term src ss ts '[] Quantity
+teQuantity :: Source src => Inj_Sym ss Quantity => Quantity -> Term src ss ts '[] (() #> Quantity)
teQuantity a = Term noConstraint tyQuantity $ teSym @Quantity $ quantity a
instance TypeInstancesFor Subable
instance Gram_Term_AtomsFor src ss g Subable
instance (Source src, Inj_Sym ss Subable) => ModuleFor src ss Subable where
- moduleFor _s = ["Subable"] `moduleWhere`
+ moduleFor = ["Subable"] `moduleWhere`
[ "-" `withInfixB` (SideL, 6) := teSubable_sub
]
instance Gram_Term_AtomsFor src ss g Transaction
instance (Source src, Inj_Sym ss Transaction) => ModuleFor src ss Transaction where
- moduleFor _s = ["Transaction"] `moduleWhere`
+ moduleFor = ["Transaction"] `moduleWhere`
[ "date" := teTransaction_date
, "postings" := teTransaction_postings
]
tyTransaction :: Source src => Inj_Len vs => Type src vs Transaction
tyTransaction = tyConst @(K Transaction) @Transaction
-teTransaction_date :: TermDef Transaction '[] (Transaction -> Date)
+teTransaction_date :: TermDef Transaction '[] (() #> (Transaction -> Date))
teTransaction_date = Term noConstraint (tyTransaction ~> tyDate) $ teSym @Transaction $ lam1 transaction_date
-teTransaction_postings :: TermDef Transaction '[] (Transaction -> Postings)
+teTransaction_postings :: TermDef Transaction '[] (() #> (Transaction -> Postings))
teTransaction_postings = Term noConstraint (tyTransaction ~> tyPostings) $ teSym @Transaction $ lam1 transaction_postings
instance TypeInstancesFor Unit
instance Gram_Term_AtomsFor src ss g Unit
instance (Source src, Inj_Sym ss Unit) => ModuleFor src ss Unit where
- moduleFor _s = ["Unit"] `moduleWhere`
+ moduleFor = ["Unit"] `moduleWhere`
[
]
tyUnit :: Source src => Inj_Len vs => Type src vs Unit
tyUnit = tyConst @(K Unit) @Unit
-teUnit :: Source src => Inj_Sym ss Unit => Unit -> Term src ss ts '[] Unit
+teUnit :: Source src => Inj_Sym ss Unit => Unit -> Term src ss ts '[] (() #> Unit)
teUnit a = Term noConstraint tyUnit $ teSym @Unit $ unit a
<$> some (choice $ unicat <$> [Unicat_Letter])
-}
instance (Source src, Inj_Sym ss Zipper) => ModuleFor src ss Zipper where
- moduleFor _s = ["TreeMap", "Zipper"] `moduleWhere`
+ moduleFor = ["TreeMap", "Zipper"] `moduleWhere`
[
]
sourcephile / git / comptalang.git / commitdiff