add Token, Satisfy, OneOf parsers

src/Symparsec/Parser/Satisfy.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Symparsec.Parser.Satisfy ( type Satisfy, type OneOf ) where
+
+import Symparsec.Parser.Common
+
+-- may also be defined using @Token@
+type Satisfy :: (Char ~> Bool) -> PParser Char
+data Satisfy chPred ps
+type instance App (Satisfy chPred) ps = SatisfyStart chPred ps (UnconsState ps)
+
+type family SatisfyStart chPred psPrev mps where
+    SatisfyStart chPred psPrev '(Just ch, ps) = SatisfyValidate psPrev ps ch (chPred @@ ch)
+    SatisfyStart chPred psPrev '(Nothing, ps) =
+        'Reply (Err (Error1 "expected at least 1 char")) ps
+
+type family SatisfyValidate psPrev ps ch res where
+    SatisfyValidate psPrev ps ch True  = 'Reply (OK ch) ps
+    SatisfyValidate psPrev ps ch False =
+        'Reply (Err (Error1 "satisfy: char failed predicate")) psPrev
+
+type OneOf :: [Char] -> PParser Char
+type OneOf chs = Satisfy (ElemSym chs)
+
+-- TODO put in singleraeh
+type Elem :: a -> [a] -> Bool
+type family Elem a as where
+    Elem _ '[]    = False
+    Elem a (a:_)  = True
+    Elem a (_:as) = Elem a as
+
+-- NOTE: flipped from "normal" Elem
+type ElemSym :: [a] -> a ~> Bool
+data ElemSym as a
+type instance App (ElemSym as) a = Elem a as

src/Symparsec/Parser/Token.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Symparsec.Parser.Token ( type Token ) where
+
+import Symparsec.Parser.Common
+
+-- | Should match @token@ from megaparsec. Backtracks.
+type Token :: (Char ~> Maybe a) -> PParser a
+data Token chParse ps
+type instance App (Token chParse) ps = TokenStart chParse ps (UnconsState ps)
+type family TokenStart chParse psPrev mps where
+    TokenStart chParse psPrev '(Just ch, ps) = TokenParse psPrev ps (chParse @@ ch)
+    TokenStart chParse psPrev '(Nothing, ps) =
+        'Reply (Err (Error1 "expected at least 1 char")) ps
+type family TokenParse psPrev ps res where
+    TokenParse psPrev ps (Just a) = 'Reply (OK a) ps
+    TokenParse psPrev ps Nothing  =
+        'Reply (Err (Error1 "token: char failed parse (TODO print char here)")) psPrev

src/Symparsec/Parsers.hs

@@ -28,6 +28,9 @@ module Symparsec.Parsers
   , type While
   , type TakeWhile
   , type Count
+  , type Token
+  , type Satisfy
+  , type OneOf
 
   -- * Common non-combinator
   -- $noncomb-common
@@ -58,10 +61,12 @@ import Symparsec.Parser.Isolate
 import Symparsec.Parser.Literal
 import Symparsec.Parser.Monad
 import Symparsec.Parser.Natural
+import Symparsec.Parser.Satisfy
 import Symparsec.Parser.Skip
 import Symparsec.Parser.Take
 import Symparsec.Parser.TakeRest
 import Symparsec.Parser.TakeWhile
+import Symparsec.Parser.Token
 import Symparsec.Parser.Try
 import Symparsec.Parser.While
 import DeFun.Core

symparsec.cabal

@@ -45,10 +45,12 @@ library
       Symparsec.Parser.Monad
       Symparsec.Parser.Natural
       Symparsec.Parser.Natural.Digits
+      Symparsec.Parser.Satisfy
       Symparsec.Parser.Skip
       Symparsec.Parser.Take
       Symparsec.Parser.TakeRest
       Symparsec.Parser.TakeWhile
+      Symparsec.Parser.Token
       Symparsec.Parser.Try
       Symparsec.Parser.While
       Symparsec.Parser.While.Predicates