symparsec (empty) → 0.4.0
raw patch · 22 files changed
+1293/−0 lines, 22 filesdep +basedep +defun-coredep +symparsec
Dependencies added: base, defun-core, symparsec, type-spec
Files
- CHANGELOG.md +22/−0
- LICENSE +20/−0
- README.md +125/−0
- src/Symparsec.hs +13/−0
- src/Symparsec/Internal/Digits.hs +68/−0
- src/Symparsec/Internal/List.hs +9/−0
- src/Symparsec/Parser.hs +59/−0
- src/Symparsec/Parser/Common.hs +36/−0
- src/Symparsec/Parser/End.hs +9/−0
- src/Symparsec/Parser/Isolate.hs +72/−0
- src/Symparsec/Parser/Literal.hs +53/−0
- src/Symparsec/Parser/Natural.hs +74/−0
- src/Symparsec/Parser/Or.hs +175/−0
- src/Symparsec/Parser/Skip.hs +44/−0
- src/Symparsec/Parser/Take.hs +45/−0
- src/Symparsec/Parser/Then.hs +69/−0
- src/Symparsec/Parser/Then/VoidLeft.hs +70/−0
- src/Symparsec/Parser/Then/VoidRight.hs +74/−0
- src/Symparsec/Parsers.hs +54/−0
- src/Symparsec/Run.hs +83/−0
- symparsec.cabal +96/−0
- test/Main.hs +23/−0
+ CHANGELOG.md view
@@ -0,0 +1,22 @@+## 0.4.0 (2024-05-12)+* rebrand from symbol-parser to Symparsec+* rename `Drop` -> `Skip` (more commonly used for monadic parsers)+* document parsers+* provide fixity declarations for infix binary combinators++## 0.3.0 (2024-04-20)+* add new parsers: `Take`, `:<|>:`+* tons of cleanup, renaming (`RunParser` -> `Run`)+* add handful of tests (via type-spec)++## 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.++ * basic combinators: `Drop`, `Isolate`, `NatHex` (etc.), sequencing+ * acceptable error messages
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 Ben Orchard (@raehik) <thefirstmuffinman@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,125 @@+# Symparsec+Type level string (`Symbol`) parser combinators.++It's a Parsec for `Symbol`s; thus, Symparsec.++Previously named symbol-parser.++## Features+* Define parsers compositionally, largely as you would on the term level.+* Pretty parse errors.+* Hopefully decent performance.+* No runtime cost (you shall find no term level code here).++## Examples+```haskell+ghci> import Symparsec+ghci> :k! Run (Drop 3 :*>: Isolate 2 NatDec :<*>: (Drop 3 :*>: NatHex)) "___10___FF"+...+= Right '( '(10, 255), "")+```++## Why?+Via `GHC.Generics`, we may inspect Haskell data types on the type level.+Constructor names are `Symbols`. Ever reify these, then perform some sort of+checking or parsing on the term level? Symparsec does the parsing on the type+level instead. Catch bugs earlier, get faster runtime.++## Design+### Parser basics+[hackage-defun-core]: https://hackage.haskell.org/package/defun-core+[hackage-symbols]: https://hackage.haskell.org/package/symbols++_(Note that I may omit "type-level" when referring to type-level operations.)_++Until GHC 9.2, `Symbol`s were largely opaque. You could get them, but you+couldn't _decompose_ them like you could `String`s with `uncons :: [a] -> Maybe+(a, [a])`. Some Haskellers took this as a challenge (see+[symbols][hackage-symbols]). But realistically, we needed a bit more compiler+support.++As of GHC 9.2, `Symbol`s may be decomposed via `UnconsSymbol :: Symbol -> Maybe+(Char, Symbol)`. We thus design a `Char`-based parser:++```haskell+type ParserCh s r = Char -> s -> Result s r+data Result s r = Cont s | Done r | Err E+```++A parser is a function which takes a `Char`, the current state `s`, and returns+some result:++* `Cont s`: keep going, here's the next state `s`+* `Done r`: parse successful with value `r`+* `Err E`: parse error, details in the `E` (a structured error)++`Run` handles calling the parser `Char` by `Char`, threading the state through,+and does some bookkeeping for nice errors.++This is a good first step, but we have some outstanding issues:++* What do we do when we reach the end of the string?+* How do we initialize parser state?+* How do we pass parsers around? (As of 2024-04-20, GHC HEAD does not support+ unsaturated type families.)++As always, types are our salvation.++```haskell+type ParserEnd s r = s -> Either E r+type Parser s r = (ParserChSym s r, ParserEndSym s r, s)++type ParserChSym s r = Char ~> s ~> Result s r+type ParserEndSym s r = s ~> Either E r+```++We define a parser as a tuple of a character parser, an end handler, and an+initial state. The types ending in `Sym` are _defunctionalization symbols_,+which enable us to pass our parsers around as type-level functions. The plumbing+is provided Oleg's fantastic library [defun-core][hackage-defun-core].++### Example: `NatDec`+Let's write a parser that parses a natural decimal.++```haskell+type NatDec = '(NatDecChSym, NatDecEndSym, 0)++type NatDecCh ch acc = NatDecCh' acc (ParseDecimalDigitSym @@ ch)+type family NatDecCh' acc mDigit where+ NatDecCh' acc (Just digit) = Cont (acc * 10 + digit)+ NatDecCh' acc Nothing = Err -- ...++type NatDecEnd acc = Right acc++-- boring defunctionalization symbol definitions+```++At each `Char`, we attempt to parse as a digit. If it's valid, we multiply the+current accumulator by 10 (a left shift) and add the digit value. At the end of+the string, we simply emit the current accumulator.++It can be that easy to define a parser with Symparsec! But it isn't always.+Combinators get weird thanks to state handling. Take a look at `Isolate`, then+`Then`.++### Pitfall: Character parsers always consume+There is no backtracking or lookahead, that you do not implement yourself. This+keeps the parser execution extremely simple, but breaks null parsers such as+`Drop 0`, so these must be handled specially (unless you don't getting mind+stuck type families on misuse).++For concrete examples, see the implementation of `Drop` and `Literal`.++### Pitfall: Not all parsers are definable+* No changing parser state. Thus, parsers such as `Try :: Parser s r -> Parser+ (s, [Char]) r` are not definable. _Parsers may not backtrack._+ * Combinators such as `<|>` can emulate backtracking, but they are complex and+ hard to reason about (they may have bugs!).++## Contributing+I would gladly accept further combinators or other suggestions. Please add an+issue or pull request, or contact me via email or whatever (I'm raehik+everywhere).++## License+Provided under the MIT license. See `LICENSE` for license text.
+ src/Symparsec.hs view
@@ -0,0 +1,13 @@+module Symparsec+ (+ -- * Base definitions+ Parser+ , Run++ -- * Parsers+ , module Symparsec.Parsers+ ) where++import Symparsec.Run+import Symparsec.Parser+import Symparsec.Parsers
+ src/Symparsec/Internal/Digits.hs view
@@ -0,0 +1,68 @@+{- | Parse digits from type-level 'Char's.++A 'Nothing' indicates the given 'Char' was not a valid digit for the given base.+-}++module Symparsec.Internal.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++-- | 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++-- | 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++-- | 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
+ src/Symparsec/Internal/List.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Internal.List where++-- | Reverse a type level list.+type Reverse as = Reverse' as '[]+type family Reverse' (as :: [k]) (acc :: [k]) :: [k] where+ Reverse' '[] acc = acc+ Reverse' (a : as) acc = Reverse' as (a : acc)
+ src/Symparsec/Parser.hs view
@@ -0,0 +1,59 @@+-- | Base definitions for type-level symbol parsers.++module Symparsec.Parser+ (+ -- * Parsers+ ParserCh+ , Result(..)+ , ParserEnd+ , E(..)++ -- * Defun symbols+ , Parser+ , ParserChSym+ , ParserEndSym+ ) where++import GHC.TypeLits+import DeFun.Core ( type (~>) )++-- | Parse a 'Char' with the given state.+--+-- The action is always consuming. For this reason, you may need to look ahead+-- for the final case, so as to not consume an extra 'Char'. This prevents many+-- zero-length parsers. It's a bit weird. See+-- 'Data.Type.Symbol.Parser.Parser.Drop' for an example.+type ParserCh s r = Char -> s -> Result s r++-- | The result of a single step of a parser.+data Result s r+ = Cont s -- ^ OK, continue with the given state+ | Done r -- ^ OK, parse successful with result @r@+ | Err E -- ^ parse error++-- | What a parser should do at the end of a 'Symbol'.+type ParserEnd s r = s -> Either E r++-- | Parser error.+data E+ -- | Base parser error.+ = EBase+ Symbol -- ^ parser name+ ErrorMessage -- ^ error message++ -- | Inner parser error inside combinator.+ | EIn+ Symbol -- ^ combinator name+ E -- ^ inner error++-- | A parser you can pass (heh) around.+--+-- Parsers are defined by the product of a 'ParserCh' character parser,+-- 'ParserEnd' end handler, and 's' starting state.+type Parser s r = (ParserChSym s r, ParserEndSym s r, s)++-- | A defunctionalization symbol for a 'ParserCh'.+type ParserChSym s r = Char ~> s ~> Result s r++-- | A defunctionalization symbol for a 'ParserEnd'.+type ParserEndSym s r = s ~> Either E r
+ src/Symparsec/Parser/Common.hs view
@@ -0,0 +1,36 @@+-- | Common definitions for parsers.++module Symparsec.Parser.Common+ ( FailChSym+ , FailEndSym+ , EmitEndSym+ , ErrParserLimitation+ ) where++import Symparsec.Parser+import GHC.TypeLits+import DeFun.Core ( type App, type (~>) )++-- | Fail with the given message when given any character to parse.+type FailChSym :: Symbol -> ErrorMessage -> ParserChSym s r+data FailChSym name e f+type instance App (FailChSym name e) f = FailChSym1 name e f++type FailChSym1 :: Symbol -> ErrorMessage -> Char -> s ~> Result s r+data FailChSym1 name e ch s+type instance App (FailChSym1 name e ch) s = Err (EBase name e)++-- | Fail with the given message if we're at the end of the symbol.+type FailEndSym :: Symbol -> ErrorMessage -> ParserEndSym s r+data FailEndSym name e s+type instance App (FailEndSym name e) s = Left (EBase name e)++-- | At the end of the symbol, emit parser state.+type EmitEndSym :: ParserEndSym r r+data EmitEndSym r+type instance App EmitEndSym r = Right r++-- | Helper for writing error messages to do with parser limitations (e.g. if+-- you tried to use a non-consuming parser like @Skip 0@).+type ErrParserLimitation :: Symbol -> ErrorMessage+type ErrParserLimitation msg = Text "parser limitation: " :<>: Text msg
+ src/Symparsec/Parser/End.hs view
@@ -0,0 +1,9 @@+module Symparsec.Parser.End ( End ) where++import Symparsec.Parser ( Parser )+import Symparsec.Parser.Common ( FailChSym, EmitEndSym )+import GHC.TypeLits ( ErrorMessage(Text) )++-- | Assert end of symbol, or fail.+type End :: Parser () ()+type End = '(FailChSym "End" (Text "expected end of symbol"), EmitEndSym, '())
+ src/Symparsec/Parser/Isolate.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.Isolate ( Isolate ) where++import Symparsec.Parser+import Symparsec.Parser.Common+import GHC.TypeLits+import DeFun.Core ( type (~>), type (@@), type App )++-- | Run the given parser isolated to the next @n@ characters.+--+-- All isolated characters must be consumed.+type Isolate :: Natural -> Parser s r -> Parser (Natural, s) r+type family Isolate n p where+ Isolate 0 '(pCh, pEnd, s) =+ '( FailChSym "Isolate" (ErrParserLimitation "cannot isolate 0")+ , IsolateEndSym, '(0, s))+ Isolate n '(pCh, pEnd, s) = '(IsolateChSym pCh pEnd, IsolateEndSym, '(n-1, s))++type IsolateCh+ :: ParserChSym s r+ -> ParserEndSym s r+ -> ParserCh (Natural, s) r+type family IsolateCh pCh pEnd ch s where+ IsolateCh pCh pEnd ch '(0, s) = IsolateInnerEnd' pEnd (pCh @@ ch @@ s)+ IsolateCh pCh pEnd ch '(n, s) = IsolateInner n (pCh @@ ch @@ s)++-- TODO clean up names here++--type IsolateInnerEnd' :: Either ErrorMessage r -> Result (Natural, s) r+type family IsolateInnerEnd' pEnd res where+ IsolateInnerEnd' pEnd (Err e) = Err (EIn "Isolate" e)+ IsolateInnerEnd' pEnd (Done r) = Done r+ IsolateInnerEnd' pEnd (Cont s) = IsolateInnerEnd (pEnd @@ s)++type IsolateInnerEnd :: Either E r -> Result (Natural, s) r+type family IsolateInnerEnd a where+ IsolateInnerEnd (Left e) = Err (EIn "Isolate" e)+ IsolateInnerEnd (Right r) = Done r++type IsolateInner :: Natural -> Result s r -> Result (Natural, s) r+type family IsolateInner n a where+ IsolateInner n (Cont s) = Cont '(n-1, s)+ IsolateInner _ (Err e) = Err e+ IsolateInner n (Done _) = Err (EBase "Isolate"+ ( Text "isolated parser ended without consuming all input ("+ :<>: ShowType n :<>: Text " remaining)" ))++type IsolateEnd :: ParserEnd (Natural, s) r+type family IsolateEnd s where+ IsolateEnd '(0, s) = Right '(0, s)+ IsolateEnd '(n, s) = Left (EBase "Isolate"+ ( Text "tried to isolate more than present (needed "+ :<>: ShowType n :<>: Text " more)" ))++type IsolateChSym+ :: ParserChSym s r+ -> ParserEndSym s r+ -> ParserChSym (Natural, s) r+data IsolateChSym pCh pEnd f+type instance App (IsolateChSym pCh pEnd) f = IsolateChSym1 pCh pEnd f++type IsolateChSym1+ :: ParserChSym s r+ -> ParserEndSym s r+ -> Char -> (Natural, s) ~> Result (Natural, s) r+data IsolateChSym1 pCh pEnd ch s+type instance App (IsolateChSym1 pCh pEnd ch) s = IsolateCh pCh pEnd ch s++type IsolateEndSym :: ParserEndSym (Natural, s) r+data IsolateEndSym s+type instance App IsolateEndSym s = IsolateEnd s
+ src/Symparsec/Parser/Literal.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.Literal ( Literal ) where++import Symparsec.Parser+import Symparsec.Parser.Common+import GHC.TypeLits+import DeFun.Core ( type (~>), type App )++-- | Parse the given 'Symbol'.+type Literal :: Symbol -> Parser (Char, Maybe (Char, Symbol)) ()+type Literal sym = Literal' (UnconsSymbol sym)++type EEmptyLit = ErrParserLimitation "cannot parse empty literal"++type family Literal' msym where+ Literal' Nothing =+ '( FailChSym "Literal" EEmptyLit+ , FailEndSym "Literal" EEmptyLit, '( '\0', Nothing))+ Literal' (Just '(ch, sym)) =+ '(LiteralChSym, LiteralEndSym, '(ch, UnconsSymbol sym))++type family LiteralCh ch s where+ LiteralCh ch0 '(ch0, Just '(ch1, sym)) = Cont '(ch1, UnconsSymbol sym)+ LiteralCh ch0 '(ch0, Nothing) = Done '()+ LiteralCh ch '(ch0, msym) = Err (EBase "Literal"+ ( Text "expected " :<>: ShowType ch0+ :<>: Text ", got " :<>: ShowType ch))++type LiteralEnd :: ParserEnd (Char, Maybe (Char, Symbol)) ()+type family LiteralEnd s where+ LiteralEnd '(ch0, msym) = Left (EBase "Literal"+ ( Text "still parsing literal: "+ :<>: Text (ConsSymbol ch0 (ReconsSymbol msym))))++type family ReconsSymbol msym where+ ReconsSymbol Nothing = ""+ ReconsSymbol (Just '(ch, sym)) = ConsSymbol ch sym++type LiteralChSym :: ParserChSym (Char, Maybe (Char, Symbol)) ()+data LiteralChSym f+type instance App LiteralChSym f = LiteralChSym1 f++type LiteralChSym1+ :: Char+ -> (Char, Maybe (Char, Symbol))+ ~> Result (Char, Maybe (Char, Symbol)) ()+data LiteralChSym1 ch s+type instance App (LiteralChSym1 ch) s = LiteralCh ch s++type LiteralEndSym :: ParserEndSym (Char, Maybe (Char, Symbol)) ()+data LiteralEndSym s+type instance App LiteralEndSym s = LiteralEnd s
+ src/Symparsec/Parser/Natural.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE UndecidableInstances #-} -- for natural multiplication etc.++module Symparsec.Parser.Natural+ ( NatBin, NatOct, NatDec, NatHex+ , NatBase+ ) where++import Symparsec.Parser+import Symparsec.Parser.Common ( EmitEndSym )+import GHC.TypeLits+import DeFun.Core ( type (~>), type App, type (@@) )+import Symparsec.Internal.Digits++-- | Parse a binary (base 2) natural.+type NatBin = NatBase 2 ParseBinaryDigitSym++-- | Parse an octal (base 8) natural.+type NatOct = NatBase 8 ParseOctalDigitSym++-- | Parse a decimal (base 10) natural.+type NatDec = NatBase 10 ParseDecimalDigitSym++-- | Parse a hexadecimal (base 16) natural. Permits mixed-case (@0-9A-Fa-f@).+type NatHex = NatBase 16 ParseHexDigitSym++-- | Parse a natural in the given base, using the given digit parser.+type NatBase+ :: Natural -> (Char ~> Maybe Natural) -> Parser Natural Natural+type NatBase base parseDigit =+ '(NatBaseChSym base parseDigit, EmitEndSym, 0)++type NatBaseCh+ :: Natural+ -> (Char ~> Maybe Natural)+ -> ParserCh Natural Natural+type NatBaseCh base parseDigit ch n = NatBaseCh' base n (parseDigit @@ ch)++type family NatBaseCh' base n mDigit where+ NatBaseCh' base n (Just digit) = Cont (n * base + digit)+ NatBaseCh' base n Nothing = Err (EBase "NatBase"+ (Text "not a base " :<>: ShowType base :<>: Text " digit"))++type NatBaseChSym+ :: Natural+ -> (Char ~> Maybe Natural)+ -> ParserChSym Natural Natural+data NatBaseChSym base parseDigit f+type instance App (NatBaseChSym base parseDigit) f =+ NatBaseChSym1 base parseDigit f++type NatBaseChSym1+ :: Natural+ -> (Char ~> Maybe Natural)+ -> Char -> Natural+ ~> Result Natural Natural+data NatBaseChSym1 base parseDigit ch n+type instance App (NatBaseChSym1 base parseDigit ch) n =+ NatBaseCh base parseDigit ch n++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/Symparsec/Parser/Or.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE UndecidableInstances #-}++{- | Choice operator. Try left; if it fails, try right.++This is a problematic combinator:++ * Implementation is clumsy due to internal parser state being untouchable.+ We must record seen characters, in order to replay them on the right parser+ in case the left parser fails.+ * Errors degrade due to left parser errors being discarded. Perhaps your+ string was one character off a successful left parse; but if it fails, you+ won't see that error.+ * It's hard to reason about. It might break in certain situations.+-}+++module Symparsec.Parser.Or ( (:<|>:) ) where++import Symparsec.Parser+import Symparsec.Internal.List ( Reverse )+import DeFun.Core ( type (@@), type App )++-- | Parser choice. Try left; if it fails, backtrack and try right.+--+-- Be warned that this parser is experimental, and likely brittle. If possible,+-- consider designing your schema to permit non-backtracking parsing. Or if not,+-- have both sides always parse the same length, in which case this parser+-- should probably work fine.+infixl 3 :<|>:+type (:<|>:)+ :: Parser sl rl+ -> Parser sr rr+ -> Parser (Either (sl, [Char]) sr) (Either rl rr)+type family pl :<|>: pr where+ '(plCh, plEnd, sl) :<|>: '(prCh, prEnd, sr) =+ '(OrChSym plCh prCh sr, OrEndSym plEnd prCh prEnd sr, Left '(sl, '[]))++type OrCh+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> ParserCh (Either (sl, [Char]) sr) (Either rl rr)+type family OrCh plCh prCh sr ch s where+ -- | Parsing left+ OrCh plCh prCh sr ch (Left '(sl, chs)) =+ OrChL prCh sr (ch : chs) (plCh @@ ch @@ sl)++ -- | Parsing right (left failed and was successfully replayed)+ OrCh plCh prCh _ ch (Right sr) =+ OrChR (prCh @@ ch @@ sr)++-- TODO [Char] is actually nonempty, but it's awkward because we need to reverse+-- it and place the known char at the end. we _can_ fix this, but it's just+-- annoying lol+type OrChL+ :: ParserChSym sr rr+ -> sr+ -> [Char]+ -> Result sl rl+ -> Result (Either (sl, [Char]) sr) (Either rl rr)+type family OrChL prCh sr chs resl where+ -- | Left parser OK, continue+ OrChL _ _ chs (Cont sl) = Cont (Left '(sl, chs))++ -- | Left parser OK, done+ OrChL _ _ chs (Done rl) = Done (Left rl)++ -- | Left parser failed: ignore, replay consumed characters on right parser+ OrChL prCh sr chs (Err _ ) =+ OrChLReplay prCh (Reverse chs) (Cont sr)++-- TODO [Char] is nonempty, see 'OrChL'. also if we fix that, we can get better+-- equation ordering!+type OrChLReplay+ :: ParserChSym sr rr+ -> [Char]+ -> Result sr rr+ -> Result (Either (sl, [Char]) sr) (Either rl rr)+type family OrChLReplay prCh chs resr where+ -- | Right parser OK, last char+ OrChLReplay prCh (ch : '[]) (Cont sr) = OrChR (prCh @@ ch @@ sr)++ -- | Right parser OK, keep replaying+ OrChLReplay prCh (ch : chs) (Cont sr) =+ OrChLReplay prCh chs (prCh @@ ch @@ sr)++ -- | Right parser fail: wrap error+ --+ -- TODO error behaviour here?+ OrChLReplay prCh chs (Err er) = Err (EIn "Or(R)" er)++ -- | Right parser done: early success+ --+ -- If this matches before we finish replaying, any remaining replay+ -- characters are lost. This _should_ break certain parses. Or, maybe it+ -- only breaks return symbol..? In which case, we can fix by returning+ -- the extra replayed chars in our return type???? TODO+ OrChLReplay prCh chs (Done rr) = Done (Right rr)+ -- (EBase "Or" (ErrParserLimitation "cannot parse less on right of Or"))++type family OrChR resr where+ OrChR (Cont sr) = Cont (Right sr)+ OrChR (Done rr) = Done (Right rr)+ OrChR (Err er) = Err (EIn "Or(R)" er)++type OrEnd+ :: ParserEndSym sl rl+ -> ParserChSym sr rr+ -> ParserEndSym sr rr+ -> sr+ -> ParserEnd (Either (sl, [Char]) sr) (Either rl rr)+type family OrEnd plEnd prCh prEnd sr res where+ -- | Input ended on L.+ OrEnd plEnd prCh prEnd sr (Left '(sl, chs)) =+ OrEndL prCh prEnd sr chs (plEnd @@ sl)++ -- | Input ended on R.+ OrEnd plEnd prCh prEnd _ (Right sr) = OrEndR (prEnd @@ sr)++type OrEndR+ :: Either E rr+ -> Either E (Either rl rr)+type family OrEndR s where+ OrEndR (Left er) = Left (EIn "Or(R)" er)+ OrEndR (Right rr) = Right (Right rr)++type OrEndL+ :: ParserChSym sr rr+ -> ParserEndSym sr rr+ -> sr+ -> [Char]+ -> Either E rl+ -> Either E (Either rl rr)+type family OrEndL prCh prEnd sr chs res where+ OrEndL prCh prEnd sr chs (Right rl) = Right (Left rl)+ OrEndL prCh prEnd sr chs (Left el) =+ OrChLReplay' prCh prEnd (Reverse chs) (Cont sr)++type OrChLReplay'+ :: ParserChSym sr rr+ -> ParserEndSym sr rr+ -> [Char]+ -> Result sr rr+ -> Either E (Either rl rr)+type family OrChLReplay' prCh prEnd chs resr where+ OrChLReplay' prCh prEnd (ch : '[]) (Cont sr) =+ OrEndR' prEnd (prCh @@ ch @@ sr)+ OrChLReplay' prCh prEnd (ch : chs) (Cont sr) =+ OrChLReplay' prCh prEnd chs (prCh @@ ch @@ sr)+ OrChLReplay' prCh prEnd chs (Err er) = Left (EIn "Or(R)" er)++ -- TODO Here, we successfully ended while replaying left-consumed chars.+ -- This may not work if it's wrapped in further combinators, I'm unsure.+ OrChLReplay' prCh prEnd chs (Done rr) = Right (Right rr)+ -- (EBase "Or" (ErrParserLimitation "cannot parse less on right of Or"))++type family OrEndR' prEnd s where+ OrEndR' prEnd (Err er) = Left (EIn "Or(R)" er)+ OrEndR' prEnd (Done rr) = Right (Right rr)+ OrEndR' prEnd (Cont sr) = OrEndR (prEnd @@ sr)++data OrChSym plCh prCh sr f+type instance App (OrChSym plCh prCh sr) f = OrChSym1 plCh prCh sr f++data OrChSym1 plCh prCh sr ch s+type instance App (OrChSym1 plCh prCh sr ch) s = OrCh plCh prCh sr ch s++type OrEndSym+ :: ParserEndSym sl rl+ -> ParserChSym sr rr+ -> ParserEndSym sr rr+ -> sr+ -> ParserEndSym (Either (sl, [Char]) sr) (Either rl rr)+data OrEndSym plEnd prCh prEnd sr s+type instance App (OrEndSym plEnd prCh prEnd sr) s = OrEnd plEnd prCh prEnd sr s
+ src/Symparsec/Parser/Skip.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE UndecidableInstances #-} -- for natural subtraction++module Symparsec.Parser.Skip ( Skip, Skip' ) where++import Symparsec.Parser+import Symparsec.Parser.Common+import GHC.TypeLits+import DeFun.Core ( type (~>), type App )++-- | Skip forward @n@ characters. Fails if fewer than @n@ characters are+-- available.+type Skip :: Natural -> Parser Natural ()+type family Skip n where+ Skip 0 =+ '(FailChSym "Skip" (ErrParserLimitation "can't drop 0"), SkipEndSym, 0)+ Skip n = Skip' n++-- | Unsafe 'Skip' which doesn't check for @n=0@. May get stuck.+type Skip' :: Natural -> Parser Natural ()+type Skip' n = '(SkipChSym, SkipEndSym, n)++type SkipCh :: ParserCh Natural ()+type family SkipCh ch n where+ SkipCh _ 1 = Done '()+ SkipCh _ n = Cont (n-1)++type SkipEnd :: ParserEnd Natural ()+type family SkipEnd n where+ SkipEnd 0 = Right '()+ SkipEnd n = Left (EBase "Skip"+ ( Text "tried to drop "+ :<>: ShowType n :<>: Text " chars from empty symbol"))++type SkipChSym :: ParserChSym Natural ()+data SkipChSym f+type instance App SkipChSym f = SkipChSym1 f++type SkipChSym1 :: Char -> Natural ~> Result Natural ()+data SkipChSym1 ch n+type instance App (SkipChSym1 ch) n = SkipCh ch n++type SkipEndSym :: ParserEndSym Natural ()+data SkipEndSym n+type instance App SkipEndSym n = SkipEnd n
+ src/Symparsec/Parser/Take.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.Take ( Take ) where++import Symparsec.Parser+import Symparsec.Parser.Common+import GHC.TypeLits+import DeFun.Core ( type (~>), type App )++-- | Return the next @n@ characters.+type Take :: Natural -> Parser (Natural, [Char]) Symbol+type family Take n where+ Take 0 =+ '( FailChSym "Take" (ErrParserLimitation "can't take 0")+ , TakeEndSym, '(0, '[]))+ Take n = '(TakeChSym, TakeEndSym, '(n, '[]))++type TakeCh :: ParserCh (Natural, [Char]) Symbol+type family TakeCh ch s where+ TakeCh ch '(1, chs) = Done (RevCharsToSymbol (ch : chs))+ TakeCh ch '(n, chs) = Cont '(n-1, ch : chs)++type TakeEnd :: ParserEnd (Natural, [Char]) Symbol+type family TakeEnd s where+ TakeEnd '(0, chs) = Right (RevCharsToSymbol chs)+ TakeEnd '(n, _) = Left (EBase "Take"+ ( Text "tried to take "+ :<>: ShowType n :<>: Text " chars from empty symbol"))++type RevCharsToSymbol chs = RevCharsToSymbol' "" chs+type family RevCharsToSymbol' sym chs where+ RevCharsToSymbol' sym '[] = sym+ RevCharsToSymbol' sym (ch : chs) = RevCharsToSymbol' (ConsSymbol ch sym) chs++type TakeChSym :: ParserChSym (Natural, [Char]) Symbol+data TakeChSym f+type instance App TakeChSym f = TakeChSym1 f++type TakeChSym1 :: Char -> (Natural, [Char]) ~> Result (Natural, [Char]) Symbol+data TakeChSym1 ch s+type instance App (TakeChSym1 ch) s = TakeCh ch s++type TakeEndSym :: ParserEndSym (Natural, [Char]) Symbol+data TakeEndSym s+type instance App TakeEndSym s = TakeEnd s
+ src/Symparsec/Parser/Then.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.Then ( (:<*>:) ) where++import Symparsec.Parser+import GHC.TypeLits+import DeFun.Core ( type (~>), type (@@), type App )++-- | Sequence two parsers, running left then right, and return both results.+infixl 4 :<*>:+type (:<*>:)+ :: Parser sl rl+ -> Parser sr rr+ -> Parser (Either sl (rl, sr)) (rl, rr)+type family pl :<*>: pr where+ '(plCh, plEnd, sl) :<*>: '(prCh, prEnd, sr) =+ '(ThenChSym plCh prCh sr, ThenEndSym prEnd, Left sl)++type ThenCh+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> ParserCh (Either sl (rl, sr)) (rl, rr)+type family ThenCh plCh prCh sr ch s where+ ThenCh plCh prCh sr ch (Left sl) =+ ThenL sr (plCh @@ ch @@ sl)+ ThenCh plCh prCh _ ch (Right '(rl, sr)) =+ ThenR rl (prCh @@ ch @@ sr)++type family ThenL sr resl where+ ThenL sr (Err el) = Err (EIn "Then(L)" 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 (EIn "Then(R)" 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 (EBase "Then" (Text "ended during left"))+ ThenEnd prEnd (Right '(rl, sr)) =+ ThenEnd' rl (prEnd @@ sr)++type family ThenEnd' rl s where+ ThenEnd' rl (Left er) = Left (EIn "Then(R)" er)+ ThenEnd' rl (Right rr) = Right '(rl, rr)++type ThenChSym+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> ParserChSym (Either sl (rl, sr)) (rl, rr)+data ThenChSym plCh prCh sr f+type instance App (ThenChSym plCh prCh sr) f = ThenChSym1 plCh prCh sr f++type ThenChSym1+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> Char -> Either sl (rl, sr) ~> Result (Either sl (rl, sr)) (rl, rr)+data ThenChSym1 plCh prCh sr ch s+type instance App (ThenChSym1 plCh prCh sr ch) s = ThenCh plCh prCh sr ch s++type ThenEndSym+ :: ParserEndSym sr rr+ -> ParserEndSym (Either sl (rl, sr)) (rl, rr)+data ThenEndSym prEnd s+type instance App (ThenEndSym prEnd) s = ThenEnd prEnd s
+ src/Symparsec/Parser/Then/VoidLeft.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.Then.VoidLeft ( (:*>:) ) where++import Symparsec.Parser+import GHC.TypeLits+import DeFun.Core ( type (~>), type (@@), type App )++-- | Sequence two parsers, running left then right, and discard the return value+-- of the left parser.+infixl 4 :*>:+type (:*>:)+ :: Parser sl rl+ -> Parser sr rr+ -> Parser (Either sl sr) rr+type family pl :*>: pr where+ '(plCh, plEnd, sl) :*>: '(prCh, prEnd, sr) =+ '(ThenVLChSym plCh prCh sr, ThenVLEndSym prEnd, Left sl)++type ThenVLCh+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> ParserCh (Either sl sr) rr+type family ThenVLCh plCh prCh sr ch s where+ ThenVLCh plCh prCh sr ch (Left sl) =+ ThenVLL sr (plCh @@ ch @@ sl)+ ThenVLCh plCh prCh _ ch (Right sr) =+ ThenVLR (prCh @@ ch @@ sr)++type family ThenVLL sr resl where+ ThenVLL sr (Err el) = Err (EIn "ThenVL(L)" el)+ ThenVLL sr (Cont sl) = Cont (Left sl)+ ThenVLL sr (Done rl) = Cont (Right sr)++type family ThenVLR resr where+ ThenVLR (Err er) = Err (EIn "ThenVL(R)" er)+ ThenVLR (Cont sr) = Cont (Right sr)+ ThenVLR (Done rr) = Done rr++type family ThenVLEnd prEnd s where+ ThenVLEnd prEnd (Left sl) =+ Left (EBase "ThenVL" (Text "ended during left"))+ ThenVLEnd prEnd (Right sr) = ThenVLEnd' (prEnd @@ sr)++type family ThenVLEnd' s where+ ThenVLEnd' (Left er) = Left (EIn "ThenVL(R)" er)+ ThenVLEnd' (Right rr) = Right rr++type ThenVLChSym+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> ParserChSym (Either sl sr) rr+data ThenVLChSym plCh prCh sr f+type instance App (ThenVLChSym plCh prCh sr) f = ThenVLChSym1 plCh prCh sr f++type ThenVLChSym1+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> Char -> Either sl sr ~> Result (Either sl sr) rr+data ThenVLChSym1 plCh prCh sr ch s+type instance App (ThenVLChSym1 plCh prCh sr ch) s = ThenVLCh plCh prCh sr ch s++type ThenVLEndSym+ :: ParserEndSym sr rr+ -> ParserEndSym (Either sl sr) rr+data ThenVLEndSym prEnd s+type instance App (ThenVLEndSym prEnd) s = ThenVLEnd prEnd s
+ src/Symparsec/Parser/Then/VoidRight.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Parser.Then.VoidRight ( (:<*:) ) where++import Symparsec.Parser+import GHC.TypeLits+import DeFun.Core ( type (~>), type (@@), type App )++-- | Sequence two parsers, running left then right, and discard the return value+-- of the right parser.+--+-- Consider using 'Data.Type.Symbol.Parser.Parser.Then.VoidLeft.:*>:' instead,+-- which is simpler and potentially faster since we parse left-to-right.+infixl 4 :<*:+type (:<*:)+ :: Parser sl rl+ -> Parser sr rr+ -> Parser (Either sl (rl, sr)) rl+type family pl :<*: pr where+ '(plCh, plEnd, sl) :<*: '(prCh, prEnd, sr) =+ '(ThenVRChSym plCh prCh sr, ThenVREndSym prEnd, Left sl)++type ThenVRCh+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> ParserCh (Either sl (rl, sr)) rl+type family ThenVRCh plCh prCh sr ch s where+ ThenVRCh plCh prCh sr ch (Left sl) =+ ThenVRL sr (plCh @@ ch @@ sl)+ ThenVRCh plCh prCh _ ch (Right '(rl, sr)) =+ ThenVRR rl (prCh @@ ch @@ sr)++type family ThenVRL sr resl where+ ThenVRL sr (Err el) = Err (EIn "ThenVR(L)" 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 (EIn "ThenVR(R)" 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 (EBase "ThenVR" (Text "ended during left"))+ ThenVREnd prEnd (Right '(rl, sr)) =+ ThenVREnd' rl (prEnd @@ sr)++type family ThenVREnd' rl s where+ ThenVREnd' rl (Left er) = Left (EIn "ThenVR(R)" er)+ ThenVREnd' rl (Right rr) = Right rl++type ThenVRChSym+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> ParserChSym (Either sl (rl, sr)) rl+data ThenVRChSym plCh prCh sr f+type instance App (ThenVRChSym plCh prCh sr) f = ThenVRChSym1 plCh prCh sr f++type ThenVRChSym1+ :: ParserChSym sl rl+ -> ParserChSym sr rr+ -> sr+ -> Char -> Either sl (rl, sr) ~> Result (Either sl (rl, sr)) rl+data ThenVRChSym1 plCh prCh sr ch s+type instance App (ThenVRChSym1 plCh prCh sr ch) s = ThenVRCh plCh prCh sr ch s++type ThenVREndSym+ :: ParserEndSym sr rr+ -> ParserEndSym (Either sl (rl, sr)) rl+data ThenVREndSym prEnd s+type instance App (ThenVREndSym prEnd) s = ThenVREnd prEnd s
+ src/Symparsec/Parsers.hs view
@@ -0,0 +1,54 @@+-- | Re-exported type-level symbol parsers.+--+-- You may ignore the equations that Haddock displays: they are internal and+-- irrelevant to library usage.++module Symparsec.Parsers+ (+ -- * Binary combinators+ -- $binary-combinators+ (:<*>:)+ , (:*>:)+ , (:<*:)+ , (:<|>:)++ -- * Positional+ -- $positional+ , Take+ , Skip+ , End+ , Isolate++ -- * Basic+ -- $basic+ , Literal++ -- ** Naturals+ , NatDec+ , NatHex+ , NatBin+ , NatOct+ , NatBase+ ) where++import Symparsec.Parser.Isolate+import Symparsec.Parser.Skip+import Symparsec.Parser.Natural+import Symparsec.Parser.Then+import Symparsec.Parser.Then.VoidLeft+import Symparsec.Parser.Then.VoidRight+import Symparsec.Parser.Literal+import Symparsec.Parser.End+import Symparsec.Parser.Take+import Symparsec.Parser.Or++-- $binary-combinators+-- Parsers that combine two parsers. Any parsers that have term-level parallels+-- will use the same fixity e.g. ':<*>:' is @infixl 4@, same as '<*>'.++-- $positional+-- Parsers that relate to symbol position e.g. length, end of symbol.++-- $basic+-- Simple non-combinator parsers. Probably fundamental in some way e.g. very+-- general or common.
+ src/Symparsec/Run.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE UndecidableInstances #-}++module Symparsec.Run ( Run ) where++import Symparsec.Parser+import GHC.TypeLits+import DeFun.Core ( type (@@) )++-- | Run the given parser on the given 'Symbol'.+type Run :: Parser s r -> Symbol -> Either ErrorMessage (r, Symbol)+type family Run p sym where+ Run '(pCh, pEnd, s) sym =+ MapLeftPrettyERun (RunStart pCh pEnd s (UnconsSymbol sym))++type family RunStart pCh pEnd s msym where+ -- | Parsing non-empty string: call main loop+ RunStart pCh pEnd s (Just '(ch, sym)) =+ RunCh pCh pEnd 0 ch (UnconsSymbol sym) (pCh @@ ch @@ s)++ -- | Parsing empty string: call special early exit+ RunStart pCh pEnd s Nothing = RunEnd0 (pEnd @@ s)++-- | Inspect character parser result.+--+-- This is purposely written so that the main case is at the top, and a single+-- equation (we parse, prepare next character and inspect character parser+-- result at the same time). My hope is that this keeps GHC fast.+type family RunCh pCh pEnd idx ch' msym res where+ -- | OK, and more to come: parse next character+ RunCh pCh pEnd idx ch' (Just '(ch, sym)) (Cont s) =+ RunCh pCh pEnd (idx+1) ch (UnconsSymbol sym) (pCh @@ ch @@ s)++ -- | OK, and we're at the end of the string: run end parser+ RunCh pCh pEnd idx ch' Nothing (Cont s) =+ RunEnd idx ch' (pEnd @@ s)++ -- | OK, and we're finished early: return value and remaining string+ RunCh pCh pEnd idx ch' msym (Done r) =+ Right '(r, ReconsSymbol msym)++ -- | Parse error: return error+ RunCh pCh pEnd idx ch' msym (Err e) =+ Left ('ERun idx ch' e)++-- | Inspect end parser result.+type RunEnd :: Natural -> Char -> Either E r -> Either ERun (r, Symbol)+type family RunEnd idx ch res where+ RunEnd idx ch (Right r) = Right '(r, "")+ RunEnd idx ch (Left e) = Left ('ERun idx ch e)++-- | Inspect end parser result for the empty string, where we have no previous+-- character or (meaningful) index.+type family RunEnd0 res where+ RunEnd0 (Right r) = Right '(r, "")+ RunEnd0 (Left e) = Left (ERun0 e)++type PrettyERun :: ERun -> ErrorMessage+type family PrettyERun e where+ PrettyERun (ERun0 e) = Text "parse error on empty string" :$$: PrettyE e+ PrettyERun ('ERun idx ch e) =+ Text "parse error at index " :<>: ShowType idx+ :<>: Text ", char " :<>: ShowType ch :$$: PrettyE e++type family PrettyE e where+ PrettyE (EBase name emsg) = Text name :<>: Text ": " :<>: emsg+ PrettyE (EIn name e) = Text name :<>: Text ": " :<>: PrettyE e++type family MapLeftPrettyERun eea where+ MapLeftPrettyERun (Left e) = Left (PrettyERun e)+ MapLeftPrettyERun (Right a) = Right a++-- | Re-construct the output from 'UnconsSymbol'.+type family ReconsSymbol msym where+ ReconsSymbol Nothing = ""+ ReconsSymbol (Just '(ch, sym)) = ConsSymbol ch sym++-- | Error while running parser.+data ERun+ -- | Parser error at index X, character C.+ = ERun Natural Char E++ -- | Parser error on the empty string.+ | ERun0 E
+ symparsec.cabal view
@@ -0,0 +1,96 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name: symparsec+version: 0.4.0+synopsis: Type level string parser combinators+description: Please see README.md.+category: Types, Data+homepage: https://github.com/raehik/symparsec#readme+bug-reports: https://github.com/raehik/symparsec/issues+author: Ben Orchard+maintainer: Ben Orchard <thefirstmuffinman@gmail.com>+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++source-repository head+ type: git+ location: https://github.com/raehik/symparsec++library+ exposed-modules:+ Symparsec+ Symparsec.Internal.Digits+ Symparsec.Internal.List+ Symparsec.Parser+ Symparsec.Parser.Common+ Symparsec.Parser.End+ Symparsec.Parser.Isolate+ Symparsec.Parser.Literal+ Symparsec.Parser.Natural+ Symparsec.Parser.Or+ Symparsec.Parser.Skip+ Symparsec.Parser.Take+ Symparsec.Parser.Then+ Symparsec.Parser.Then.VoidLeft+ Symparsec.Parser.Then.VoidRight+ Symparsec.Parsers+ Symparsec.Run+ other-modules:+ Paths_symparsec+ hs-source-dirs:+ src+ default-extensions:+ LambdaCase+ NoStarIsType+ DerivingVia+ DeriveAnyClass+ GADTs+ RoleAnnotations+ DefaultSignatures+ TypeFamilies+ DataKinds+ MagicHash+ ghc-options: -Wall -Wno-unticked-promoted-constructors+ build-depends:+ base >=4.16 && <5+ , defun-core ==0.1.*+ default-language: GHC2021++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_symparsec+ hs-source-dirs:+ test+ default-extensions:+ LambdaCase+ NoStarIsType+ DerivingVia+ DeriveAnyClass+ GADTs+ RoleAnnotations+ DefaultSignatures+ TypeFamilies+ DataKinds+ MagicHash+ ghc-options: -Wall -Wno-unticked-promoted-constructors+ build-depends:+ base >=4.16 && <5+ , defun-core ==0.1.*+ , symparsec+ , type-spec >=0.4.0.0 && <0.5+ default-language: GHC2021
+ test/Main.hs view
@@ -0,0 +1,23 @@+module Main where++import Test.TypeSpec+import Symparsec++main :: IO ()+main = print spec++-- The type errors for failures are HILARIOUS if you're into that sort of thing.+-- Try messing with a test or two and see mad GHC gets!++type CstrX_Y =+ (Literal "Cstr" :*>: Isolate 2 NatDec)+ :<*>: (Literal "_" :*>: Isolate 2 NatHex)++spec :: Expect+ '[ Run (Literal "raehik") "raehik" `Is` Right '( '(), "")+ , Run (Literal "raeh") "raehraeh" `Is` Right '( '(), "raeh")+ , Run (Skip 3 :*>: Literal "HI") "...HI" `Is` Right '( '(), "")+ , Run (Literal "0x" :*>: NatHex) "0xfF" `Is` Right '( 255, "")+ , Run CstrX_Y "Cstr12_AB" `Is` Right '( '(12, 0xAB), "")+ ]+spec = Valid