module Text.Roundtrip.Combinators
(
text
, comma
, dot
, many
, many1
, sepBy
, chainl1
, (*>)
, (<*)
, between
, (<+>)
, optional
, optionalWithDefault
, skipSpace
, sepSpace
, optSpace
, fixedValue
) where
import Prelude hiding ((.), foldl)
import Control.Category ((.))
import Control.Isomorphism.Partial.Constructors (nothing, just, nil, cons, left, right)
import Control.Isomorphism.Partial.Derived (foldl)
import Control.Isomorphism.Partial.Iso (Iso)
import Control.Isomorphism.Partial.Prim ((<$>), inverse, element, unit, commute, ignore)
import Data.Char (String)
import Data.Maybe (Maybe)
import Data.Either (Either)
import Text.Roundtrip.Classes
many :: Syntax delta => delta alpha -> delta [alpha]
many p =
rule "many" p $
(cons <$> p <*> many p
<|> nil <$> pure ())
many1 :: Syntax delta => delta alpha -> delta [alpha]
many1 p =
rule "many1" p $ cons <$> p <*> many p
infixl 4 <+>
(<+>) :: Syntax delta => delta alpha -> delta beta -> delta (Either alpha beta)
p <+> q = (left <$> p) <|> (right <$> q)
text :: StringSyntax delta => String -> delta ()
text [] = pure ()
text (c:cs) = inverse (element ((), ()))
<$> (inverse (element c) <$> token)
<*> text cs
infixr 6 *>, <*
(*>) :: Syntax delta => delta () -> delta alpha -> delta alpha
p *> q = ruleInfix "*>" p q $ inverse unit . commute <$> p <*> q
(<*) :: Syntax delta => delta alpha -> delta () -> delta alpha
p <* q = ruleInfix "<*" p q $ inverse unit <$> p <*> q
between :: Syntax delta => delta () -> delta () -> delta alpha -> delta alpha
between p q r = p *> r <* q
chainl1 :: Syntax delta => delta alpha -> delta beta -> Iso (alpha, (beta, alpha)) alpha -> delta alpha
chainl1 arg op f
= foldl f <$> arg <*> many (op <*> arg)
optional :: Syntax delta => delta alpha -> delta (Maybe alpha)
optional x = rule "optional" x $ just <$> x <|> nothing <$> (pure ())
optionalWithDefault :: (Eq alpha, Syntax delta) => alpha -> delta alpha -> delta alpha
optionalWithDefault def x = rule "optionalWithDefault" x $ x <|> pure def
sepBy :: Syntax delta => delta alpha -> delta () -> delta [alpha]
sepBy x sep
= cons <$> x <*> many (sep *> x)
<|> nil <$> (pure ())
comma :: StringSyntax delta => delta ()
comma = text ","
dot :: StringSyntax delta => delta ()
dot = text "."
skipSpace :: StringSyntax delta => delta ()
skipSpace = ignore [] <$> many (text " ")
optSpace :: StringSyntax delta => delta ()
optSpace = ignore [()] <$> many (text " ")
sepSpace :: StringSyntax delta => delta ()
sepSpace = text " " <* skipSpace
fixedValue :: (Show a, Eq a) => a -> Iso a ()
fixedValue = inverse . element