packages feed

symbol-parser 0.1.0 → 0.2.0

raw patch · 15 files changed

+211/−255 lines, 15 files

Files

CHANGELOG.md view
@@ -1,3 +1,9 @@+## 0.2.0 (2024-04-19)+* add two more combinators: `End`, `Literal`+* remove some old code (`Data.Type.Symbol`, `Data.Type.Symbol.Natural`)+* fix base lower bound (at least base-4.16, == GHC 9.2)+* style: don't tick promoted constructors unless necessary for disambiguation+ ## 0.1.0 (2024-04-17) Initial release.
src/Data/Type/Char/Digits.hs view
@@ -2,66 +2,67 @@  A 'Nothing' indicates the given 'Char' was not a valid digit for the given base. -}+ module Data.Type.Char.Digits where  import GHC.TypeLits  -- | Parse a binary digit (0 or 1). type family ParseBinaryDigit (ch :: Char) :: Maybe Natural where-    ParseBinaryDigit '0' = 'Just 0-    ParseBinaryDigit '1' = 'Just 1-    ParseBinaryDigit _   = 'Nothing+    ParseBinaryDigit '0' = Just 0+    ParseBinaryDigit '1' = Just 1+    ParseBinaryDigit _   = Nothing  -- | Parse an octal digit (0-7). type family ParseOctalDigit (ch :: Char) :: Maybe Natural where-    ParseOctalDigit '0' = 'Just 0-    ParseOctalDigit '1' = 'Just 1-    ParseOctalDigit '2' = 'Just 2-    ParseOctalDigit '3' = 'Just 3-    ParseOctalDigit '4' = 'Just 4-    ParseOctalDigit '5' = 'Just 5-    ParseOctalDigit '6' = 'Just 6-    ParseOctalDigit '7' = 'Just 7-    ParseOctalDigit _   = 'Nothing+    ParseOctalDigit '0' = Just 0+    ParseOctalDigit '1' = Just 1+    ParseOctalDigit '2' = Just 2+    ParseOctalDigit '3' = Just 3+    ParseOctalDigit '4' = Just 4+    ParseOctalDigit '5' = Just 5+    ParseOctalDigit '6' = Just 6+    ParseOctalDigit '7' = Just 7+    ParseOctalDigit _   = Nothing  -- | Parse a decimal digit (0-9). type family ParseDecimalDigit (ch :: Char) :: Maybe Natural where-    ParseDecimalDigit '0' = 'Just 0-    ParseDecimalDigit '1' = 'Just 1-    ParseDecimalDigit '2' = 'Just 2-    ParseDecimalDigit '3' = 'Just 3-    ParseDecimalDigit '4' = 'Just 4-    ParseDecimalDigit '5' = 'Just 5-    ParseDecimalDigit '6' = 'Just 6-    ParseDecimalDigit '7' = 'Just 7-    ParseDecimalDigit '8' = 'Just 8-    ParseDecimalDigit '9' = 'Just 9-    ParseDecimalDigit _   = 'Nothing+    ParseDecimalDigit '0' = Just 0+    ParseDecimalDigit '1' = Just 1+    ParseDecimalDigit '2' = Just 2+    ParseDecimalDigit '3' = Just 3+    ParseDecimalDigit '4' = Just 4+    ParseDecimalDigit '5' = Just 5+    ParseDecimalDigit '6' = Just 6+    ParseDecimalDigit '7' = Just 7+    ParseDecimalDigit '8' = Just 8+    ParseDecimalDigit '9' = Just 9+    ParseDecimalDigit _   = Nothing  -- | Parse a hexadecimal digit (0-9A-Fa-f). -- -- Both upper and lower case are permitted. type family ParseHexDigit (ch :: Char) :: Maybe Natural where-    ParseHexDigit '0' = 'Just 0-    ParseHexDigit '1' = 'Just 1-    ParseHexDigit '2' = 'Just 2-    ParseHexDigit '3' = 'Just 3-    ParseHexDigit '4' = 'Just 4-    ParseHexDigit '5' = 'Just 5-    ParseHexDigit '6' = 'Just 6-    ParseHexDigit '7' = 'Just 7-    ParseHexDigit '8' = 'Just 8-    ParseHexDigit '9' = 'Just 9-    ParseHexDigit 'a' = 'Just 10-    ParseHexDigit 'A' = 'Just 10-    ParseHexDigit 'b' = 'Just 11-    ParseHexDigit 'B' = 'Just 11-    ParseHexDigit 'c' = 'Just 12-    ParseHexDigit 'C' = 'Just 12-    ParseHexDigit 'd' = 'Just 13-    ParseHexDigit 'D' = 'Just 13-    ParseHexDigit 'e' = 'Just 14-    ParseHexDigit 'E' = 'Just 14-    ParseHexDigit 'f' = 'Just 15-    ParseHexDigit 'F' = 'Just 15-    ParseHexDigit _   = 'Nothing+    ParseHexDigit '0' = Just 0+    ParseHexDigit '1' = Just 1+    ParseHexDigit '2' = Just 2+    ParseHexDigit '3' = Just 3+    ParseHexDigit '4' = Just 4+    ParseHexDigit '5' = Just 5+    ParseHexDigit '6' = Just 6+    ParseHexDigit '7' = Just 7+    ParseHexDigit '8' = Just 8+    ParseHexDigit '9' = Just 9+    ParseHexDigit 'a' = Just 10+    ParseHexDigit 'A' = Just 10+    ParseHexDigit 'b' = Just 11+    ParseHexDigit 'B' = Just 11+    ParseHexDigit 'c' = Just 12+    ParseHexDigit 'C' = Just 12+    ParseHexDigit 'd' = Just 13+    ParseHexDigit 'D' = Just 13+    ParseHexDigit 'e' = Just 14+    ParseHexDigit 'E' = Just 14+    ParseHexDigit 'f' = Just 15+    ParseHexDigit 'F' = Just 15+    ParseHexDigit _   = Nothing
− src/Data/Type/Symbol.hs 
@@ -1,12 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Data.Type.Symbol where--import GHC.TypeLits---- | Get the length of a symbol.-type Length sym = Length' 0 (UnconsSymbol sym)--type family Length' len mchsym where-    Length' len 'Nothing          = len-    Length' len ('Just '(_, sym)) = Length' (len+1) (UnconsSymbol sym)
− src/Data/Type/Symbol/Natural.hs 
@@ -1,120 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--{- | Parse 'Natural's from type-level 'Symbol's.--The type functions here may return errors. Use the provided and throw with-'TypeError', or wrap in your own error handling.--TODO--  * Oh dear. Oh dear. Oh dear. If I want to get proper working composition with-    meaningful errors, where the index pays attention to what we Drop... then I-    need to write a type-level parser monad. That's it. These parsers need to-    take in parser state (well, just character index is OK), and emit that state-    on success. Oh dear. Oh no.--}--module Data.Type.Symbol.Natural where--import Data.Type.Char.Digits-import GHC.TypeLits-import Data.Type.Bool ( type If )-import Data.Type.Equality ( type (==) )-import DeFun.Core ( type (~>), type App, type (@@) )-import Data.Type.Symbol ( type Length )---- | Parse a 'Symbol' describing a  binary     (base  2) natural---   to its 'Natural' value.-type ParseBinarySymbol  sym = ParseSymbolDigits  2 ParseBinaryDigitSym  sym---- | Parse a 'Symbol' describing an octal      (base  8) natural---   to its 'Natural' value.-type ParseOctalSymbol   sym = ParseSymbolDigits  8 ParseOctalDigitSym   sym---- | Parse a 'Symbol' describing a  decimal    (base 10) natural---   to its 'Natural' value.-type ParseDecimalSymbol sym = ParseSymbolDigits 10 ParseDecimalDigitSym sym---- | Parse a 'Symbol' describing a hexadecimal (base 16) natural---   to its 'Natural' value.-type ParseHexSymbol     sym = ParseSymbolDigits 16 ParseHexDigitSym     sym--type family PrettyE e where-    PrettyE 'EEmptySymbol = 'Text "empty symbol"-    PrettyE ('EBadDigit base ch idx) = PrettyEBadDigit base ch idx--type family MapLeftPrettyE e where-    MapLeftPrettyE ('Right a) = 'Right a-    MapLeftPrettyE ('Left  e) = 'Left (PrettyE e)--type family FromRightParseResult sym eab where-    FromRightParseResult _   ('Right a) = a-    FromRightParseResult sym ('Left  e) = TypeError-        (      'Text "error while parsing symbol: " :<>: 'Text sym-          :$$: PrettyE e-        )--data E = EBadDigit Natural Char Natural | EEmptySymbol--type PrettyEBadDigit base ch idx =-         'Text "could not parse character as base "-    :<>: 'ShowType base :<>: 'Text " digit"-    :$$: 'ShowType ch :<>: 'Text " at index " :<>: 'ShowType idx---- | Parse a symbol to a 'Natural' using the given base and digit parser.-type ParseSymbolDigits base tfDigitValue sym =-    If (Length sym == 0) ('Left 'EEmptySymbol)-        (WrapEBadDigit base-            (ParseSymbolDigits' base tfDigitValue ('Just 0) '\0' 0 (Length sym - 1) (UnconsSymbol sym)))--type family WrapEBadDigit base eab where-    WrapEBadDigit _    ('Right b) = 'Right b-    WrapEBadDigit base ('Left  '(ch, sym)) = 'Left ('EBadDigit base ch sym)--type ParseSymbolDigits'-    :: Natural                 {- ^ base -}-    -> (Char ~> Maybe Natural) {- ^ digit parser (defun symbol) -}-    -> Maybe Natural           {- ^ accumulator (Nothing means failure) -}-    -> Char                    {- ^ previous parsed character -}-    -> Natural                 {- ^ index in symbol -}-    -> Natural                 {- ^ current exponent -}-    -> Maybe (Char, Symbol)    {- ^ remaining symbol -}-    -> Either (Char, Natural) Natural-type family ParseSymbolDigits' base tfParseDigit mn prevCh idx expo mchsym where-    ParseSymbolDigits' base tfParseDigit ('Just n) prevCh idx expo 'Nothing =-        -- previous digit parsed, no more characters: all done-        'Right n-    -- note that the above will return 0 for empty symbols!-    -- we could add an equation for that... but it would be inefficient, since-    -- we only need to check once. instead, we handle that outside.-    ParseSymbolDigits' base tfParseDigit 'Nothing  prevCh idx expo mchsym =-        -- digit parse error: emit problematic 'Char' and its index-        -- the -1 is clumsy but the easiest way to achieve zero-indexing-        -- safe: we always start with 'Just, so if we get here we're at least 1-        'Left '(prevCh, idx-1)-    ParseSymbolDigits' base tfParseDigit ('Just n) prevCh idx expo ('Just '(ch, sym)) =-        -- previous digit parsed, characters remaining: parse next digit-        ParseSymbolDigits' base tfParseDigit-            (ParseSymbolDigits'Inc (base^expo) n (tfParseDigit @@ ch))-            ch (idx+1) (expo-1) (UnconsSymbol sym)---- little helper for incrementing accumulator, or failing to 'Nothing'-type family ParseSymbolDigits'Inc mult n mDigit where-    ParseSymbolDigits'Inc mult n 'Nothing      = 'Nothing-    ParseSymbolDigits'Inc mult n ('Just digit) = 'Just (n + digit*mult)--type ParseBinaryDigitSym :: Char ~> Maybe Natural-data ParseBinaryDigitSym a-type instance App ParseBinaryDigitSym a = ParseBinaryDigit a--type ParseOctalDigitSym :: Char ~> Maybe Natural-data ParseOctalDigitSym a-type instance App ParseOctalDigitSym a = ParseOctalDigit a--type ParseDecimalDigitSym :: Char ~> Maybe Natural-data ParseDecimalDigitSym a-type instance App ParseDecimalDigitSym a = ParseDecimalDigit a--type ParseHexDigitSym :: Char ~> Maybe Natural-data ParseHexDigitSym a-type instance App ParseHexDigitSym a = ParseHexDigit a
src/Data/Type/Symbol/Parser.hs view
@@ -13,6 +13,8 @@    -- ** Primitives   , Drop+  , Literal+  , End    -- *** Naturals   , NatDec@@ -29,7 +31,17 @@ import Data.Type.Symbol.Parser.Then import Data.Type.Symbol.Parser.Then.VoidLeft import Data.Type.Symbol.Parser.Then.VoidRight+import Data.Type.Symbol.Parser.Literal+import Data.Type.Symbol.Parser.End +-- | Sequence parsers, returning both values in a tuple. type pl :<*>: pr = Then   pl pr++-- | Sequence parsers, discarding the return value of the left parser type pl  :*>: pr = ThenVL pl pr++-- | Sequence parsers, discarding the return value of the right parser.+--+-- Consider using ':*>:' instead, which is simpler and potentially faster since+-- we parse L->R. type pl :<*:  pr = ThenVR pl pr
src/Data/Type/Symbol/Parser/Drop.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableInstances #-} -- for natural subtraction  module Data.Type.Symbol.Parser.Drop ( type Drop ) where @@ -11,16 +11,16 @@  type DropCh :: ParserCh Natural () type family DropCh _ch n where-    DropCh _ 0 = 'Err ('Text "can't drop 0 due to parser limitations. sorry")-    DropCh _ 1 = 'Done '()-    DropCh _ n = 'Cont (n-1)+    DropCh _ 0 = Err (Text "can't drop 0 due to parser limitations. sorry")+    DropCh _ 1 = Done '()+    DropCh _ n = Cont (n-1)  type DropEnd :: ParserEnd Natural () type family DropEnd n where-    DropEnd 0 = 'Right '()-    DropEnd n = 'Left-      ( 'Text "tried to drop "-        :<>: 'ShowType n :<>: 'Text " chars from empty symbol")+    DropEnd 0 = Right '()+    DropEnd n = Left+      ( Text "tried to drop "+        :<>: ShowType n :<>: Text " chars from empty symbol")  type DropChSym :: ParserChSym Natural () data DropChSym f
+ src/Data/Type/Symbol/Parser/End.hs view
@@ -0,0 +1,29 @@+module Data.Type.Symbol.Parser.End ( type End ) where++import Data.Type.Symbol.Parser.Internal+import GHC.TypeLits+import DeFun.Core ( type (~>), type App )++type End :: Parser () ()+type End = '(EndChSym, EndEndSym, '())++type EndCh :: ParserCh () ()+type family EndCh ch u where+    EndCh _ '() = Err (Text "expected end of string")++type EndEnd :: ParserEnd () ()+type family EndEnd u where+    EndEnd '() = Right '()++type EndChSym :: ParserChSym () ()+data EndChSym f+type instance App EndChSym f = EndChSym1 f++type EndChSym1+    :: Char -> () ~> Result () ()+data EndChSym1 ch n+type instance App (EndChSym1 ch) n = EndCh ch n++type EndEndSym :: ParserEndSym () ()+data EndEndSym msym+type instance App EndEndSym '() = EndEnd '()
src/Data/Type/Symbol/Parser/Internal.hs view
@@ -20,19 +20,19 @@  -- TODO maybe take an mch? Nothing at start, Just otherwise type family RunParser' pCh pEnd idx s msym where-    RunParser' pCh pEnd idx s 'Nothing =+    RunParser' pCh pEnd idx s Nothing =         RunParserEnd idx (pEnd @@ s)-    RunParser' pCh pEnd idx s ('Just '(ch, sym)) =+    RunParser' pCh pEnd idx s (Just '(ch, sym)) =         RunParser'' pCh pEnd idx ch (pCh @@ ch @@ s) sym  type family RunParserEnd idx end where-    RunParserEnd idx ('Left  e) = 'Left e-    RunParserEnd idx ('Right r) = 'Right '(r, "")+    RunParserEnd idx (Left  e) = Left e+    RunParserEnd idx (Right r) = Right '(r, "")  type family RunParser'' pCh pEnd idx ch res sym where-    RunParser'' pCh pEnd idx ch ('Err  e) sym = 'Left e -- TODO annotate error-    RunParser'' pCh pEnd idx ch ('Done r) sym = 'Right '(r, sym)-    RunParser'' pCh pEnd idx ch ('Cont s) sym =+    RunParser'' pCh pEnd idx ch (Err  e) sym = Left e -- TODO annotate error+    RunParser'' pCh pEnd idx ch (Done r) sym = Right '(r, sym)+    RunParser'' pCh pEnd idx ch (Cont s) sym =         RunParser' pCh pEnd (idx+1) s (UnconsSymbol sym)  -- TODO could do this if more parsers end up storing state which they emit
src/Data/Type/Symbol/Parser/Isolate.hs view
@@ -18,7 +18,7 @@     -> ParserCh (Natural, s) r type family IsolateCh pCh pEnd ch s where     IsolateCh pCh pEnd ch '(0, s) =-        'Err ('Text "cannot isolate 0 due to parser limitations")+        Err (Text "cannot isolate 0 due to parser limitations")     IsolateCh pCh pEnd ch '(1, s) = IsolateInnerEnd' pEnd (pCh @@ ch @@ s)     IsolateCh pCh pEnd ch '(n, s) = IsolateInner n (pCh @@ ch @@ s) @@ -26,29 +26,29 @@  --type IsolateInnerEnd' :: Either ErrorMessage r -> Result (Natural, s) r type family IsolateInnerEnd' pEnd res where-    IsolateInnerEnd' pEnd ('Err  e) = 'Err  e-    IsolateInnerEnd' pEnd ('Done r) = 'Done r-    IsolateInnerEnd' pEnd ('Cont s) = IsolateInnerEnd (pEnd @@ s)+    IsolateInnerEnd' pEnd (Err  e) = Err  e+    IsolateInnerEnd' pEnd (Done r) = Done r+    IsolateInnerEnd' pEnd (Cont s) = IsolateInnerEnd (pEnd @@ s)  type IsolateInnerEnd :: Either ErrorMessage r -> Result (Natural, s) r type family IsolateInnerEnd a where-    IsolateInnerEnd ('Left  e) = 'Err  e-    IsolateInnerEnd ('Right r) = 'Done r+    IsolateInnerEnd (Left  e) = Err  e+    IsolateInnerEnd (Right r) = Done r  type IsolateInner :: Natural -> Result s r -> Result (Natural, s) r type family IsolateInner n a where-    IsolateInner _ ('Err  e) = 'Err  e-    IsolateInner _ ('Done _) =+    IsolateInner _ (Err  e) = Err  e+    IsolateInner _ (Done _) =         -- TODO put n in that error too plz-        'Err ('Text "isolated parser ended without consuming all input")-    IsolateInner n ('Cont s) = 'Cont '(n-1, s)+        Err (Text "isolated parser ended without consuming all input")+    IsolateInner n (Cont s) = Cont '(n-1, s)  type IsolateEnd :: ParserEnd (Natural, s) r type family IsolateEnd s where-    IsolateEnd '(0, s) = 'Right '(0, s)+    IsolateEnd '(0, s) = Right '(0, s)     IsolateEnd '(n, s) =         -- TODO-        'Left ('Text "isolate wanted more than was there")+        Left (Text "isolate wanted more than was there")  type IsolateChSym     :: ParserChSym s r
+ src/Data/Type/Symbol/Parser/Literal.hs view
@@ -0,0 +1,36 @@+module Data.Type.Symbol.Parser.Literal ( type Literal ) where++import Data.Type.Symbol.Parser.Internal+import GHC.TypeLits+import DeFun.Core ( type (~>), type App )++type Literal :: Symbol -> Parser (Maybe (Char, Symbol)) ()+type Literal sym = '(LiteralChSym, LiteralEndSym, UnconsSymbol sym)++type LiteralCh :: ParserCh (Maybe (Char, Symbol)) ()+type family LiteralCh ch msym where+    LiteralCh ch Nothing = Err+        (Text "can't parse the empty literal due to parser limitations")+    LiteralCh ch (Just '(ch,  ""))  = Done '()+    LiteralCh ch (Just '(ch,  sym)) = Cont (UnconsSymbol sym)+    LiteralCh ch (Just '(ch', sym)) = Err+        (Text "expected " :<>: ShowType ch :<>: Text ", got " :<>: ShowType ch')++type LiteralEnd :: ParserEnd (Maybe (Char, Symbol)) ()+type family LiteralEnd msym where+    LiteralEnd Nothing = Right '()+    LiteralEnd (Just '(ch, sym)) = Left+      ( Text "still parsing literal: " :<>: Text (ConsSymbol ch sym))++type LiteralChSym :: ParserChSym (Maybe (Char, Symbol)) ()+data LiteralChSym f+type instance App LiteralChSym f = LiteralChSym1 f++type LiteralChSym1+    :: Char -> Maybe (Char, Symbol) ~> Result (Maybe (Char, Symbol)) ()+data LiteralChSym1 ch n+type instance App (LiteralChSym1 ch) n = LiteralCh ch n++type LiteralEndSym :: ParserEndSym (Maybe (Char, Symbol)) ()+data LiteralEndSym msym+type instance App LiteralEndSym msym = LiteralEnd msym
src/Data/Type/Symbol/Parser/Natural.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableInstances #-} -- for natural multiplication etc.  module Data.Type.Symbol.Parser.Natural where @@ -26,12 +26,12 @@         NatBaseCh' base n (parseDigit @@ ch)  type family NatBaseCh' base n mDigit where-    NatBaseCh' base n 'Nothing      =-        'Err ('Text "not a base " :<>: 'ShowType base :<>: 'Text " digit")-    NatBaseCh' base n ('Just digit) = 'Cont (n * base + digit)+    NatBaseCh' base n Nothing      =+        Err (Text "not a base " :<>: ShowType base :<>: Text " digit")+    NatBaseCh' base n (Just digit) = Cont (n * base + digit)  type NatBaseEnd :: ParserEnd Natural Natural-type NatBaseEnd n = 'Right n+type NatBaseEnd n = Right n  type NatBaseChSym     :: Natural@@ -69,4 +69,3 @@ type ParseHexDigitSym :: Char ~> Maybe Natural data ParseHexDigitSym a type instance App ParseHexDigitSym a = ParseHexDigit a-
src/Data/Type/Symbol/Parser/Then.hs view
@@ -12,7 +12,7 @@     -> Parser (Either sl (rl, sr)) (rl, rr) type family Then pl pr where     Then '(plCh, plEnd, sl) '(prCh, prEnd, sr) =-        '(ThenChSym plCh prCh sr, ThenEndSym prEnd, 'Left sl)+        '(ThenChSym plCh prCh sr, ThenEndSym prEnd, Left sl)  type ThenCh     :: ParserChSym sl rl@@ -20,29 +20,29 @@     -> sr     -> ParserCh (Either sl (rl, sr)) (rl, rr) type family ThenCh plCh prCh sr ch s where-    ThenCh plCh prCh sr ch ('Left  sl) =+    ThenCh plCh prCh sr ch (Left  sl) =         ThenL sr (plCh @@ ch @@ sl)-    ThenCh plCh prCh _  ch ('Right '(rl, sr)) =+    ThenCh plCh prCh _  ch (Right '(rl, sr)) =         ThenR rl (prCh @@ ch @@ sr)  type family ThenL sr resl where-    ThenL sr ('Err  el) = 'Err  ('Text "then: left error" :$$: el)-    ThenL sr ('Cont sl) = 'Cont ('Left  sl)-    ThenL sr ('Done rl) = 'Cont ('Right '(rl, sr))+    ThenL sr (Err  el) = Err  (Text "then: left error" :$$: el)+    ThenL sr (Cont sl) = Cont (Left  sl)+    ThenL sr (Done rl) = Cont (Right '(rl, sr))  type family ThenR rl resr where-    ThenR rl ('Err  er) = 'Err  ('Text "then: right error" :$$: er)-    ThenR rl ('Cont sr) = 'Cont ('Right '(rl, sr))-    ThenR rl ('Done rr) = 'Done '(rl, rr)+    ThenR rl (Err  er) = Err  (Text "then: right error" :$$: er)+    ThenR rl (Cont sr) = Cont (Right '(rl, sr))+    ThenR rl (Done rr) = Done '(rl, rr)  type family ThenEnd prEnd s where-    ThenEnd prEnd ('Left sl) = 'Left ('Text "then: ended during left")-    ThenEnd prEnd ('Right '(rl, sr)) =+    ThenEnd prEnd (Left sl) = Left (Text "then: ended during left")+    ThenEnd prEnd (Right '(rl, sr)) =         ThenEnd' rl (prEnd @@ sr)  type family ThenEnd' rl s where-    ThenEnd' rl ('Left  er) = 'Left  ('Text "then: right end error" :$$: er)-    ThenEnd' rl ('Right rr) = 'Right '(rl, rr)+    ThenEnd' rl (Left  er) = Left  (Text "then: right end error" :$$: er)+    ThenEnd' rl (Right rr) = Right '(rl, rr)  type ThenChSym     :: ParserChSym sl rl
src/Data/Type/Symbol/Parser/Then/VoidLeft.hs view
@@ -12,7 +12,7 @@     -> Parser (Either sl sr) rr type family ThenVL pl pr where     ThenVL '(plCh, plEnd, sl) '(prCh, prEnd, sr) =-        '(ThenVLChSym plCh prCh sr, ThenVLEndSym prEnd, 'Left sl)+        '(ThenVLChSym plCh prCh sr, ThenVLEndSym prEnd, Left sl)  type ThenVLCh     :: ParserChSym sl rl@@ -20,28 +20,28 @@     -> sr     -> ParserCh (Either sl sr) rr type family ThenVLCh plCh prCh sr ch s where-    ThenVLCh plCh prCh sr ch ('Left  sl) =+    ThenVLCh plCh prCh sr ch (Left  sl) =         ThenVLL sr (plCh @@ ch @@ sl)-    ThenVLCh plCh prCh _  ch ('Right sr) =+    ThenVLCh plCh prCh _  ch (Right sr) =         ThenVLR (prCh @@ ch @@ sr)  type family ThenVLL sr resl where-    ThenVLL sr ('Err  el) = 'Err  ('Text "thenvl: left error" :$$: el)-    ThenVLL sr ('Cont sl) = 'Cont ('Left  sl)-    ThenVLL sr ('Done rl) = 'Cont ('Right sr)+    ThenVLL sr (Err  el) = Err  (Text "thenvl: left error" :$$: el)+    ThenVLL sr (Cont sl) = Cont (Left  sl)+    ThenVLL sr (Done rl) = Cont (Right sr)  type family ThenVLR resr where-    ThenVLR ('Err  er) = 'Err  ('Text "thenvl: right error" :$$: er)-    ThenVLR ('Cont sr) = 'Cont ('Right sr)-    ThenVLR ('Done rr) = 'Done rr+    ThenVLR (Err  er) = Err  (Text "thenvl: right error" :$$: er)+    ThenVLR (Cont sr) = Cont (Right sr)+    ThenVLR (Done rr) = Done rr  type family ThenVLEnd prEnd s where-    ThenVLEnd prEnd ('Left  sl) = 'Left ('Text "thenvl: ended during left")-    ThenVLEnd prEnd ('Right sr) = ThenVLEnd' (prEnd @@ sr)+    ThenVLEnd prEnd (Left  sl) = Left (Text "thenvl: ended during left")+    ThenVLEnd prEnd (Right sr) = ThenVLEnd' (prEnd @@ sr)  type family ThenVLEnd' s where-    ThenVLEnd' ('Left  er) = 'Left  ('Text "thenvl: right end error" :$$: er)-    ThenVLEnd' ('Right rr) = 'Right rr+    ThenVLEnd' (Left  er) = Left  (Text "thenvl: right end error" :$$: er)+    ThenVLEnd' (Right rr) = Right rr  type ThenVLChSym     :: ParserChSym sl rl
src/Data/Type/Symbol/Parser/Then/VoidRight.hs view
@@ -12,7 +12,7 @@     -> Parser (Either sl (rl, sr)) rl type family ThenVR pl pr where     ThenVR '(plCh, plEnd, sl) '(prCh, prEnd, sr) =-        '(ThenVRChSym plCh prCh sr, ThenVREndSym prEnd, 'Left sl)+        '(ThenVRChSym plCh prCh sr, ThenVREndSym prEnd, Left sl)  type ThenVRCh     :: ParserChSym sl rl@@ -20,29 +20,29 @@     -> sr     -> ParserCh (Either sl (rl, sr)) rl type family ThenVRCh plCh prCh sr ch s where-    ThenVRCh plCh prCh sr ch ('Left  sl) =+    ThenVRCh plCh prCh sr ch (Left  sl) =         ThenVRL sr (plCh @@ ch @@ sl)-    ThenVRCh plCh prCh _  ch ('Right '(rl, sr)) =+    ThenVRCh plCh prCh _  ch (Right '(rl, sr)) =         ThenVRR rl (prCh @@ ch @@ sr)  type family ThenVRL sr resl where-    ThenVRL sr ('Err  el) = 'Err  ('Text "then: left error" :$$: el)-    ThenVRL sr ('Cont sl) = 'Cont ('Left  sl)-    ThenVRL sr ('Done rl) = 'Cont ('Right '(rl, sr))+    ThenVRL sr (Err  el) = Err  (Text "then: left error" :$$: el)+    ThenVRL sr (Cont sl) = Cont (Left  sl)+    ThenVRL sr (Done rl) = Cont (Right '(rl, sr))  type family ThenVRR rl resr where-    ThenVRR rl ('Err  er) = 'Err  ('Text "then: right error" :$$: er)-    ThenVRR rl ('Cont sr) = 'Cont ('Right '(rl, sr))-    ThenVRR rl ('Done rr) = 'Done rl+    ThenVRR rl (Err  er) = Err  (Text "then: right error" :$$: er)+    ThenVRR rl (Cont sr) = Cont (Right '(rl, sr))+    ThenVRR rl (Done rr) = Done rl  type family ThenVREnd prEnd s where-    ThenVREnd prEnd ('Left  sl) = 'Left ('Text "thenvr: ended during left")-    ThenVREnd prEnd ('Right '(rl, sr)) =+    ThenVREnd prEnd (Left  sl) = Left (Text "thenvr: ended during left")+    ThenVREnd prEnd (Right '(rl, sr)) =         ThenVREnd' rl (prEnd @@ sr)  type family ThenVREnd' rl s where-    ThenVREnd' rl ('Left  er) = 'Left  ('Text "thenvr: right end error" :$$: er)-    ThenVREnd' rl ('Right rr) = 'Right rl+    ThenVREnd' rl (Left  er) = Left  (Text "thenvr: right end error" :$$: er)+    ThenVREnd' rl (Right rr) = Right rl  type ThenVRChSym     :: ParserChSym sl rl
symbol-parser.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           symbol-parser-version:        0.1.0+version:        0.2.0 synopsis:       Type level string parser combinators description:    Please see README.md. category:       Types, Data@@ -16,6 +16,11 @@ license:        MIT license-file:   LICENSE build-type:     Simple+tested-with:+    GHC==9.8+  , GHC==9.6+  , GHC==9.4+  , GHC==9.2 extra-source-files:     README.md     CHANGELOG.md@@ -27,12 +32,12 @@ library   exposed-modules:       Data.Type.Char.Digits-      Data.Type.Symbol-      Data.Type.Symbol.Natural       Data.Type.Symbol.Parser       Data.Type.Symbol.Parser.Drop+      Data.Type.Symbol.Parser.End       Data.Type.Symbol.Parser.Internal       Data.Type.Symbol.Parser.Isolate+      Data.Type.Symbol.Parser.Literal       Data.Type.Symbol.Parser.Natural       Data.Type.Symbol.Parser.Then       Data.Type.Symbol.Parser.Then.VoidLeft@@ -52,8 +57,8 @@       TypeFamilies       DataKinds       MagicHash-  ghc-options: -Wall+  ghc-options: -Wall -Wno-unticked-promoted-constructors   build-depends:-      base >=4.14 && <5+      base >=4.16 && <5     , defun-core ==0.1.*   default-language: GHC2021