symparsec 1.0.1 → 1.1.0
raw patch · 6 files changed
+441/−7 lines, 6 filesdep ~singleraehdep ~type-level-show
Dependency ranges changed: singleraeh, type-level-show
Files
- CHANGELOG.md +5/−0
- src/Symparsec/Parser/Count.hs +147/−0
- src/Symparsec/Parser/While.hs +72/−0
- src/Symparsec/Parser/While/Predicates.hs +193/−0
- src/Symparsec/Parsers.hs +16/−2
- symparsec.cabal +8/−5
CHANGELOG.md view
@@ -1,3 +1,8 @@+## 1.1.0 (2024-06-01)+* add `While` combinator+* add `Count` combinator+* re-add `:<|>:` re-export in `Symparsec.Parsers`+ ## 1.0.1 (2024-05-27) * add `TakeRest` combinator * re-add `:<|>:` combinator with more accurate behaviour clarification
+ src/Symparsec/Parser/Count.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.Count where++import Symparsec.Parser.Common+import GHC.TypeLits hiding ( ErrorMessage(..) )+import Singleraeh.Tuple+import Singleraeh.List+import Singleraeh.Either+import Singleraeh.Natural+import DeFun.Core+import Data.Type.Equality+import Unsafe.Coerce ( unsafeCoerce )++type CountS s r = (Natural, [r], s)++type family Count n p where+ Count n ('PParser pCh pEnd s0) = Count' n pCh pEnd s0+type Count' n pCh pEnd s0 =+ 'PParser (CountChSym pCh s0) (CountEndSym pEnd s0) '(n, '[], s0)++type SCountS ss sr = STuple3 SNat (SList sr) ss++sCount+ :: SNat n+ -> SParser ss sr ('PParser pCh pEnd s0)+ -> SParser (SCountS ss sr) (SList sr) (Count' n pCh pEnd s0)+sCount n (SParser pCh pEnd s0) =+ SParser (sCountChSym pCh s0) (sCountEndSym pEnd s0) (STuple3 n SNil s0)++instance+ ( p ~ 'PParser pCh pEnd s0, SingParser p, KnownNat n+ ) => SingParser (Count' n pCh pEnd s0) where+ type PS (Count' n pCh pEnd s0) =+ SCountS (PS ('PParser pCh pEnd s0)) (PR ('PParser pCh pEnd s0))+ type PR (Count' n pCh pEnd s0) = SList (PR ('PParser pCh pEnd s0))+ singParser' = sCount SNat (singParser @p)++type family CountCh pCh s0 ch s where+ CountCh pCh s0 ch '(n, rs, s) = CountCh' pCh s0 ch n rs s++sCountChSym+ :: SParserChSym ss sr pCh+ -> ss s0+ -> SParserChSym (SCountS ss sr) (SList sr) (CountChSym pCh s0)+sCountChSym pCh s0 = Lam2 $ \ch (STuple3 n rs s) ->+ sCountCh' pCh s0 ch n rs s++type family CountCh' pCh s0 ch n rs s where+ CountCh' pCh s0 ch 0 rs s = Done (Reverse rs)+ CountCh' pCh s0 ch n rs s = CountChN pCh ch n rs s0 (pCh @@ ch @@ s)++sCountCh'+ :: SParserChSym ss sr pCh+ -> ss s0+ -> SChar ch+ -> SNat n+ -> SList sr rs+ -> ss s+ -> SResult (SCountS ss sr) (SList sr) (CountCh' pCh s0 ch n rs s)+sCountCh' pCh s0 ch n rs s =+ case testEquality n (SNat @0) of+ Just Refl -> SDone $ sReverse rs+ Nothing -> unsafeCoerce $ sCountChN pCh ch n rs s0 (pCh @@ ch @@ s)++type family CountChN pCh ch n rs s0 res where+ CountChN pCh ch n rs s0 (Cont s) = Cont '(n, rs, s)+ CountChN pCh ch n rs s0 (Done r) = CountCh' pCh s0 ch (n-1) (r:rs) s0+ CountChN pCh ch n rs s0 (Err e) = Err (ECount e)++sCountChN+ :: SParserChSym ss sr pCh+ -> SChar ch+ -> SNat n+ -> SList sr rs+ -> ss s0+ -> SResult ss sr res+ -> SResult (SCountS ss sr) (SList sr) (CountChN pCh ch n rs s0 res)+sCountChN pCh ch n rs s0 = \case+ SCont s -> SCont $ STuple3 n rs s+ SDone r -> sCountCh' pCh s0 ch (n %- SNat @1) (SCons r rs) s0+ SErr e -> SErr $ eCount e++type ECount e = EIn "Count" e+eCount :: SE e -> SE (ECount e)+eCount e = withSingE e $ singE++type CountChSym+ :: ParserChSym s r+ -> s+ -> ParserChSym (CountS s r) [r]+data CountChSym pCh s0 f+type instance App (CountChSym pCh s0) f = CountChSym1 pCh s0 f++type CountChSym1+ :: ParserChSym s r+ -> s+ -> ParserChSym1 (CountS s r) [r]+data CountChSym1 pCh s0 ch s+type instance App (CountChSym1 pCh s0 ch) s = CountCh pCh s0 ch s++type family CountEnd pEnd s0 s where+ CountEnd pEnd s0 '(n, rs, s) = CountEnd' pEnd s0 n rs s++type family CountEnd' pEnd s0 n rs s where+ CountEnd' pEnd s0 0 rs s = Right (Reverse rs)+ CountEnd' pEnd s0 n rs s = CountEndN pEnd s0 n rs (pEnd @@ s)++sCountEnd'+ :: SParserEndSym ss sr pEnd+ -> ss s0+ -> SNat n+ -> SList sr rs+ -> ss s+ -> SResultEnd (SList sr) (CountEnd' pEnd s0 n rs s)+sCountEnd' pEnd s0 n rs s =+ case testEquality n (SNat @0) of+ Just Refl -> SRight $ sReverse rs+ Nothing -> unsafeCoerce $ sCountEndN pEnd s0 n rs (pEnd @@ s)++type family CountEndN pEnd s0 n rs res where+ CountEndN pEnd s0 n rs (Right r) = CountEnd' pEnd s0 (n-1) (r:rs) s0+ CountEndN pEnd s0 n rs (Left e) = Left (ECount e)++sCountEndN+ :: SParserEndSym ss sr pEnd+ -> ss s0+ -> SNat n+ -> SList sr rs+ -> SResultEnd sr res+ -> SResultEnd (SList sr) (CountEndN pEnd s0 n rs res)+sCountEndN pEnd s0 n rs = \case+ SRight r -> sCountEnd' pEnd s0 (n %- SNat @1) (SCons r rs) s0+ SLeft e -> SLeft $ eCount e++type CountEndSym+ :: ParserEndSym s r+ -> s+ -> ParserEndSym (CountS s r) [r]+data CountEndSym pEnd s0 s+type instance App (CountEndSym pEnd s0) s = CountEnd pEnd s0 s++sCountEndSym+ :: SParserEndSym ss sr pEnd+ -> ss s0+ -> SParserEndSym (SCountS ss sr) (SList sr) (CountEndSym pEnd s0)+sCountEndSym pEnd s0 = Lam $ \(STuple3 n rs s) -> sCountEnd' pEnd s0 n rs s
+ src/Symparsec/Parser/While.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.While where++import Symparsec.Parser.Common+import DeFun.Core+import GHC.TypeLits+import Singleraeh.Bool+import Singleraeh.Either+import Symparsec.Parser.While.Predicates++-- | Run the given parser while the given character predicate succeeds.+type family While chPred p where+ While chPred ('PParser pCh pEnd s0) = While' chPred pCh pEnd s0+type While' chPred pCh pEnd s0 = 'PParser (WhileChSym chPred pCh pEnd) pEnd s0++sWhile+ :: Lam SChar SBool chPred+ -> SParser ss sr ('PParser pCh pEnd s0)+ -> SParser ss sr (While' chPred pCh pEnd s0)+sWhile chPred (SParser pCh pEnd s0) =+ SParser (sWhileChSym chPred pCh pEnd) pEnd s0++instance+ ( p ~ 'PParser pCh pEnd s0, SingParser p+ , SingChPred chPred+ ) => SingParser (While' chPred pCh pEnd s0) where+ type PS (While' chPred pCh pEnd s0) = PS ('PParser pCh pEnd s0)+ type PR (While' chPred pCh pEnd s0) = PR ('PParser pCh pEnd s0)+ singParser' = sWhile (singChPred @chPred) (singParser @p)++type WhileCh chPred pCh pEnd ch s = WhileCh' pCh pEnd ch s (chPred @@ ch)+type family WhileCh' pCh pEnd ch s res where+ WhileCh' pCh pEnd ch s True = pCh @@ ch @@ s+ WhileCh' pCh pEnd ch s False = WhileCh'' (pEnd @@ s)++type family WhileCh'' res where+ WhileCh'' (Right r) = Done r+ WhileCh'' (Left e) = Err (EWhile e)++type EWhile e = EIn "While" e+eWhile :: SE e -> SE (EWhile e)+eWhile e = withSingE e $ singE++type WhileChSym+ :: (Char ~> Bool)+ -> ParserChSym s r+ -> ParserEndSym s r+ -> ParserChSym s r+data WhileChSym chPred pCh pEnd f+type instance App (WhileChSym chPred pCh pEnd) f = WhileChSym1 chPred pCh pEnd f++type WhileChSym1+ :: (Char ~> Bool)+ -> ParserChSym s r+ -> ParserEndSym s r+ -> ParserChSym1 s r+data WhileChSym1 chPred pCh pEnd ch s+type instance App (WhileChSym1 chPred pCh pEnd ch) s = WhileCh chPred pCh pEnd ch s++sWhileChSym+ :: Lam SChar SBool chPred+ -> SParserChSym ss sr pCh+ -> SParserEndSym ss sr pEnd+ -> SParserChSym ss sr (WhileChSym chPred pCh pEnd)+sWhileChSym chPred pCh pEnd = Lam2 $ \ch s ->+ case chPred @@ ch of+ STrue -> pCh @@ ch @@ s+ SFalse ->+ case pEnd @@ s of+ SRight r -> SDone r+ SLeft e -> SErr $ eWhile e
+ src/Symparsec/Parser/While/Predicates.hs view
@@ -0,0 +1,193 @@+-- | Character predicates.++-- TODO for singling, I could cheat by inspecting the char value. should be+-- faster and better. but would need a bit more checking so cba for now.++module Symparsec.Parser.While.Predicates where++import DeFun.Core+import GHC.TypeLits+import Singleraeh.Bool+import Singleraeh.Equality ( testEqElse )+import Unsafe.Coerce ( unsafeCoerce )++class SingChPred chPred where+ singChPred :: Lam SChar SBool chPred++-- | @A-Za-z@+type IsAlpha :: Char -> Bool+type family IsAlpha ch where+ IsAlpha 'a' = True+ IsAlpha 'A' = True+ IsAlpha 'b' = True+ IsAlpha 'B' = True+ IsAlpha 'c' = True+ IsAlpha 'C' = True+ IsAlpha 'd' = True+ IsAlpha 'D' = True+ IsAlpha 'e' = True+ IsAlpha 'E' = True+ IsAlpha 'f' = True+ IsAlpha 'F' = True+ IsAlpha 'g' = True+ IsAlpha 'G' = True+ IsAlpha 'h' = True+ IsAlpha 'H' = True+ IsAlpha 'i' = True+ IsAlpha 'I' = True+ IsAlpha 'j' = True+ IsAlpha 'J' = True+ IsAlpha 'k' = True+ IsAlpha 'K' = True+ IsAlpha 'l' = True+ IsAlpha 'L' = True+ IsAlpha 'm' = True+ IsAlpha 'M' = True+ IsAlpha 'n' = True+ IsAlpha 'N' = True+ IsAlpha 'o' = True+ IsAlpha 'O' = True+ IsAlpha 'p' = True+ IsAlpha 'P' = True+ IsAlpha 'q' = True+ IsAlpha 'Q' = True+ IsAlpha 'r' = True+ IsAlpha 'R' = True+ IsAlpha 's' = True+ IsAlpha 'S' = True+ IsAlpha 't' = True+ IsAlpha 'T' = True+ IsAlpha 'u' = True+ IsAlpha 'U' = True+ IsAlpha 'v' = True+ IsAlpha 'V' = True+ IsAlpha 'w' = True+ IsAlpha 'W' = True+ IsAlpha 'x' = True+ IsAlpha 'X' = True+ IsAlpha 'y' = True+ IsAlpha 'Y' = True+ IsAlpha 'z' = True+ IsAlpha 'Z' = True+ IsAlpha _ = False++type IsAlphaSym :: Char ~> Bool+data IsAlphaSym ch+type instance App IsAlphaSym ch = IsAlpha ch++sIsAlphaSym :: Lam SChar SBool IsAlphaSym+sIsAlphaSym = Lam $ \ch ->+ testEqElse ch (SChar @'a') STrue+ $ testEqElse ch (SChar @'A') STrue+ $ testEqElse ch (SChar @'b') STrue+ $ testEqElse ch (SChar @'B') STrue+ $ testEqElse ch (SChar @'c') STrue+ $ testEqElse ch (SChar @'C') STrue+ $ testEqElse ch (SChar @'d') STrue+ $ testEqElse ch (SChar @'D') STrue+ $ testEqElse ch (SChar @'e') STrue+ $ testEqElse ch (SChar @'E') STrue+ $ testEqElse ch (SChar @'f') STrue+ $ testEqElse ch (SChar @'F') STrue+ $ testEqElse ch (SChar @'g') STrue+ $ testEqElse ch (SChar @'G') STrue+ $ testEqElse ch (SChar @'h') STrue+ $ testEqElse ch (SChar @'H') STrue+ $ testEqElse ch (SChar @'i') STrue+ $ testEqElse ch (SChar @'I') STrue+ $ testEqElse ch (SChar @'j') STrue+ $ testEqElse ch (SChar @'J') STrue+ $ testEqElse ch (SChar @'k') STrue+ $ testEqElse ch (SChar @'K') STrue+ $ testEqElse ch (SChar @'l') STrue+ $ testEqElse ch (SChar @'L') STrue+ $ testEqElse ch (SChar @'m') STrue+ $ testEqElse ch (SChar @'M') STrue+ $ testEqElse ch (SChar @'n') STrue+ $ testEqElse ch (SChar @'N') STrue+ $ testEqElse ch (SChar @'o') STrue+ $ testEqElse ch (SChar @'O') STrue+ $ testEqElse ch (SChar @'p') STrue+ $ testEqElse ch (SChar @'P') STrue+ $ testEqElse ch (SChar @'q') STrue+ $ testEqElse ch (SChar @'Q') STrue+ $ testEqElse ch (SChar @'r') STrue+ $ testEqElse ch (SChar @'R') STrue+ $ testEqElse ch (SChar @'s') STrue+ $ testEqElse ch (SChar @'S') STrue+ $ testEqElse ch (SChar @'t') STrue+ $ testEqElse ch (SChar @'T') STrue+ $ testEqElse ch (SChar @'u') STrue+ $ testEqElse ch (SChar @'U') STrue+ $ testEqElse ch (SChar @'v') STrue+ $ testEqElse ch (SChar @'V') STrue+ $ testEqElse ch (SChar @'w') STrue+ $ testEqElse ch (SChar @'W') STrue+ $ testEqElse ch (SChar @'x') STrue+ $ testEqElse ch (SChar @'X') STrue+ $ testEqElse ch (SChar @'y') STrue+ $ testEqElse ch (SChar @'Y') STrue+ $ testEqElse ch (SChar @'z') STrue+ $ testEqElse ch (SChar @'Z') STrue+ $ unsafeCoerce SFalse++instance SingChPred IsAlphaSym where singChPred = sIsAlphaSym++-- | @0-9A-Fa-f@+type IsHexDigit :: Char -> Bool+type family IsHexDigit ch where+ IsHexDigit '0' = True+ IsHexDigit '1' = True+ IsHexDigit '2' = True+ IsHexDigit '3' = True+ IsHexDigit '4' = True+ IsHexDigit '5' = True+ IsHexDigit '6' = True+ IsHexDigit '7' = True+ IsHexDigit '8' = True+ IsHexDigit '9' = True+ IsHexDigit 'a' = True+ IsHexDigit 'A' = True+ IsHexDigit 'b' = True+ IsHexDigit 'B' = True+ IsHexDigit 'c' = True+ IsHexDigit 'C' = True+ IsHexDigit 'd' = True+ IsHexDigit 'D' = True+ IsHexDigit 'e' = True+ IsHexDigit 'E' = True+ IsHexDigit 'f' = True+ IsHexDigit 'F' = True+ IsHexDigit _ = False++type IsHexDigitSym :: Char ~> Bool+data IsHexDigitSym ch+type instance App IsHexDigitSym ch = IsHexDigit ch++sIsHexDigitSym :: Lam SChar SBool IsHexDigitSym+sIsHexDigitSym = Lam $ \ch ->+ testEqElse ch (SChar @'0') STrue+ $ testEqElse ch (SChar @'1') STrue+ $ testEqElse ch (SChar @'2') STrue+ $ testEqElse ch (SChar @'3') STrue+ $ testEqElse ch (SChar @'4') STrue+ $ testEqElse ch (SChar @'5') STrue+ $ testEqElse ch (SChar @'6') STrue+ $ testEqElse ch (SChar @'7') STrue+ $ testEqElse ch (SChar @'8') STrue+ $ testEqElse ch (SChar @'9') STrue+ $ testEqElse ch (SChar @'a') STrue+ $ testEqElse ch (SChar @'A') STrue+ $ testEqElse ch (SChar @'b') STrue+ $ testEqElse ch (SChar @'B') STrue+ $ testEqElse ch (SChar @'c') STrue+ $ testEqElse ch (SChar @'C') STrue+ $ testEqElse ch (SChar @'d') STrue+ $ testEqElse ch (SChar @'D') STrue+ $ testEqElse ch (SChar @'e') STrue+ $ testEqElse ch (SChar @'E') STrue+ $ testEqElse ch (SChar @'f') STrue+ $ testEqElse ch (SChar @'F') STrue+ $ unsafeCoerce SFalse++instance SingChPred IsHexDigitSym where singChPred = sIsHexDigitSym
src/Symparsec/Parsers.hs view
@@ -10,7 +10,7 @@ (:<*>:) , (:*>:) , (:<*:)- -- , (:<|>:)+ , (:<|>:) -- * Positional -- $positional@@ -20,6 +20,13 @@ , End , Isolate + -- * Predicated+ -- $predicated+ , While, TakeWhile++ -- * TODO unsorted+ , Count+ -- * Basic -- $basic , Literal@@ -42,7 +49,9 @@ import Symparsec.Parser.End import Symparsec.Parser.Take import Symparsec.Parser.TakeRest---import Symparsec.Parser.Or+import Symparsec.Parser.Or+import Symparsec.Parser.While+import Symparsec.Parser.Count -- $binary-combinators -- Parsers that combine two parsers. Any parsers that have term-level parallels@@ -51,6 +60,11 @@ -- $positional -- Parsers that relate to symbol position e.g. length, end of symbol. +-- $predicated+-- Parsers that include character predicates.+ -- $basic -- Simple non-combinator parsers. Probably fundamental in some way e.g. very -- general or common.++type TakeWhile chPred = While chPred TakeRest
symparsec.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: symparsec-version: 1.0.1+version: 1.1.0 synopsis: Type level string parser combinators description: Please see README.md. category: Types, Data@@ -32,6 +32,7 @@ Symparsec Symparsec.Parser Symparsec.Parser.Common+ Symparsec.Parser.Count Symparsec.Parser.End Symparsec.Parser.Isolate Symparsec.Parser.Literal@@ -44,6 +45,8 @@ Symparsec.Parser.Then Symparsec.Parser.Then.VoidLeft Symparsec.Parser.Then.VoidRight+ Symparsec.Parser.While+ Symparsec.Parser.While.Predicates Symparsec.Parsers Symparsec.Run other-modules:@@ -65,8 +68,8 @@ build-depends: base >=4.18 && <5 , defun-core ==0.1.*- , singleraeh >=0.2.0 && <0.3- , type-level-show >=0.2.1 && <0.3+ , singleraeh >=0.4.0 && <0.5+ , type-level-show >=0.3.0 && <0.4 default-language: GHC2021 test-suite spec@@ -91,8 +94,8 @@ build-depends: base >=4.18 && <5 , defun-core ==0.1.*- , singleraeh >=0.2.0 && <0.3+ , singleraeh >=0.4.0 && <0.5 , symparsec- , type-level-show >=0.2.1 && <0.3+ , type-level-show >=0.3.0 && <0.4 , type-spec >=0.4.0.0 && <0.5 default-language: GHC2021