{-# LANGUAGE OverloadedStrings #-}

-- | Example parsers
module Looksee.Examples
  ( Json (..)
  , jsonParser
  , Arith (..)
  , arithParser
  , Atom (..)
  , Sexp (..)
  , sexpParser
  )
where

import Control.Applicative ((<|>))
import Data.Char (isAlpha)
import Data.Scientific (Scientific)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Void (Void)
import Looksee
  ( Parser
  , altP
  , betweenP
  , decP
  , doubleStrP
  , infixRP
  , intP
  , labelP
  , sciP
  , sepByP
  , space1P
  , stripEndP
  , stripP
  , stripStartP
  , takeWhile1P
  , textP_
  )

-- | A JSON value
data Json
  = JsonNull
  | JsonString !Text
  | JsonArray !(Seq Json)
  | JsonObject !(Seq (Text, Json))
  | JsonNum !Scientific
  | JsonBool !Bool
  deriving stock (Json -> Json -> Bool
(Json -> Json -> Bool) -> (Json -> Json -> Bool) -> Eq Json
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Json -> Json -> Bool
== :: Json -> Json -> Bool
$c/= :: Json -> Json -> Bool
/= :: Json -> Json -> Bool
Eq, Eq Json
Eq Json =>
(Json -> Json -> Ordering)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Json)
-> (Json -> Json -> Json)
-> Ord Json
Json -> Json -> Bool
Json -> Json -> Ordering
Json -> Json -> Json
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Json -> Json -> Ordering
compare :: Json -> Json -> Ordering
$c< :: Json -> Json -> Bool
< :: Json -> Json -> Bool
$c<= :: Json -> Json -> Bool
<= :: Json -> Json -> Bool
$c> :: Json -> Json -> Bool
> :: Json -> Json -> Bool
$c>= :: Json -> Json -> Bool
>= :: Json -> Json -> Bool
$cmax :: Json -> Json -> Json
max :: Json -> Json -> Json
$cmin :: Json -> Json -> Json
min :: Json -> Json -> Json
Ord, Int -> Json -> ShowS
[Json] -> ShowS
Json -> String
(Int -> Json -> ShowS)
-> (Json -> String) -> ([Json] -> ShowS) -> Show Json
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Json -> ShowS
showsPrec :: Int -> Json -> ShowS
$cshow :: Json -> String
show :: Json -> String
$cshowList :: [Json] -> ShowS
showList :: [Json] -> ShowS
Show)

-- | A JSON parser (modulo some differences in numeric parsing)
jsonParser :: Parser Void Json
jsonParser :: Parser Void Json
jsonParser = Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripP Parser Void Json
valP
 where
  valP :: Parser Void Json
valP =
    [Parser Void Json] -> Parser Void Json
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
      [ Label -> Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"null" Parser Void Json
forall {e}. ParserT e Identity Json
nullP
      , Label -> Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"bool" Parser Void Json
forall {e}. ParserT e Identity Json
boolP
      , Label -> Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"str" Parser Void Json
forall {e}. ParserT e Identity Json
strP
      , Label -> Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"array" Parser Void Json
arrayP
      , Label -> Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"object" Parser Void Json
objectP
      , Label -> Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"num" Parser Void Json
forall {e}. ParserT e Identity Json
numP
      ]
  boolP :: ParserT e Identity Json
boolP = Bool -> Json
JsonBool (Bool -> Json)
-> ParserT e Identity Bool -> ParserT e Identity Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
False Bool -> ParserT e Identity () -> ParserT e Identity Bool
forall a b. a -> ParserT e Identity b -> ParserT e Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParserT e Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"false" ParserT e Identity Bool
-> ParserT e Identity Bool -> ParserT e Identity Bool
forall a.
ParserT e Identity a
-> ParserT e Identity a -> ParserT e Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
True Bool -> ParserT e Identity () -> ParserT e Identity Bool
forall a b. a -> ParserT e Identity b -> ParserT e Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParserT e Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"true")
  numP :: ParserT e Identity Json
numP = Scientific -> Json
JsonNum (Scientific -> Json)
-> ParserT e Identity Scientific -> ParserT e Identity Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT e Identity Scientific
forall (m :: * -> *) e. Monad m => ParserT e m Scientific
sciP
  nullP :: ParserT e Identity Json
nullP = Json
JsonNull Json -> ParserT e Identity () -> ParserT e Identity Json
forall a b. a -> ParserT e Identity b -> ParserT e Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParserT e Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"null"
  strP :: ParserT e Identity Json
strP = Text -> Json
JsonString (Text -> Json)
-> ParserT e Identity Text -> ParserT e Identity Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT e Identity Text
forall (m :: * -> *) e. Monad m => ParserT e m Text
doubleStrP
  arrayP :: Parser Void Json
arrayP = Seq Json -> Json
JsonArray (Seq Json -> Json)
-> ParserT Void Identity (Seq Json) -> Parser Void Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity ()
-> ParserT Void Identity ()
-> ParserT Void Identity (Seq Json)
-> ParserT Void Identity (Seq Json)
forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (ParserT Void Identity () -> ParserT Void Identity ()
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"[")) (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"]") (ParserT Void Identity ()
-> Parser Void Json -> ParserT Void Identity (Seq Json)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepByP (ParserT Void Identity () -> ParserT Void Identity ()
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
",")) (Parser Void Json -> Parser Void Json
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP Parser Void Json
valP))
  pairP :: ParserT Void Identity (Text, Json)
pairP = do
    Text
s <- ParserT Void Identity Text
forall (m :: * -> *) e. Monad m => ParserT e m Text
doubleStrP
    ParserT Void Identity () -> ParserT Void Identity ()
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripP (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
":")
    Json
v <- Parser Void Json
valP
    (Text, Json) -> ParserT Void Identity (Text, Json)
forall a. a -> ParserT Void Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
s, Json
v)
  objectP :: Parser Void Json
objectP = Seq (Text, Json) -> Json
JsonObject (Seq (Text, Json) -> Json)
-> ParserT Void Identity (Seq (Text, Json)) -> Parser Void Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity ()
-> ParserT Void Identity ()
-> ParserT Void Identity (Seq (Text, Json))
-> ParserT Void Identity (Seq (Text, Json))
forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (ParserT Void Identity () -> ParserT Void Identity ()
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"{")) (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"}") (ParserT Void Identity ()
-> ParserT Void Identity (Text, Json)
-> ParserT Void Identity (Seq (Text, Json))
forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepByP (ParserT Void Identity () -> ParserT Void Identity ()
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
",")) (ParserT Void Identity (Text, Json)
-> ParserT Void Identity (Text, Json)
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP ParserT Void Identity (Text, Json)
pairP))

-- | An arithmetic expression
data Arith
  = ArithNum !Rational
  | ArithVar !Text
  | ArithNeg Arith
  | ArithMul Arith Arith
  | ArithAdd Arith Arith
  | ArithSub Arith Arith
  deriving stock (Arith -> Arith -> Bool
(Arith -> Arith -> Bool) -> (Arith -> Arith -> Bool) -> Eq Arith
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Arith -> Arith -> Bool
== :: Arith -> Arith -> Bool
$c/= :: Arith -> Arith -> Bool
/= :: Arith -> Arith -> Bool
Eq, Eq Arith
Eq Arith =>
(Arith -> Arith -> Ordering)
-> (Arith -> Arith -> Bool)
-> (Arith -> Arith -> Bool)
-> (Arith -> Arith -> Bool)
-> (Arith -> Arith -> Bool)
-> (Arith -> Arith -> Arith)
-> (Arith -> Arith -> Arith)
-> Ord Arith
Arith -> Arith -> Bool
Arith -> Arith -> Ordering
Arith -> Arith -> Arith
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Arith -> Arith -> Ordering
compare :: Arith -> Arith -> Ordering
$c< :: Arith -> Arith -> Bool
< :: Arith -> Arith -> Bool
$c<= :: Arith -> Arith -> Bool
<= :: Arith -> Arith -> Bool
$c> :: Arith -> Arith -> Bool
> :: Arith -> Arith -> Bool
$c>= :: Arith -> Arith -> Bool
>= :: Arith -> Arith -> Bool
$cmax :: Arith -> Arith -> Arith
max :: Arith -> Arith -> Arith
$cmin :: Arith -> Arith -> Arith
min :: Arith -> Arith -> Arith
Ord, Int -> Arith -> ShowS
[Arith] -> ShowS
Arith -> String
(Int -> Arith -> ShowS)
-> (Arith -> String) -> ([Arith] -> ShowS) -> Show Arith
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Arith -> ShowS
showsPrec :: Int -> Arith -> ShowS
$cshow :: Arith -> String
show :: Arith -> String
$cshowList :: [Arith] -> ShowS
showList :: [Arith] -> ShowS
Show)

-- | A parser for arithmetic expressions
arithParser :: Parser Void Arith
arithParser :: Parser Void Arith
arithParser = Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripP Parser Void Arith
rootP
 where
  identP :: ParserT e Identity Text
identP = (Char -> Bool) -> ParserT e Identity Text
forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhile1P Char -> Bool
isAlpha
  binaryP :: Text -> (Arith -> Arith -> Arith) -> Parser Void Arith
binaryP Text
op Arith -> Arith -> Arith
f = ((Arith, Arith) -> Arith)
-> ParserT Void Identity (Arith, Arith) -> Parser Void Arith
forall a b.
(a -> b) -> ParserT Void Identity a -> ParserT Void Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Arith -> Arith -> Arith) -> (Arith, Arith) -> Arith
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Arith -> Arith -> Arith
f) (Text
-> Parser Void Arith
-> Parser Void Arith
-> ParserT Void Identity (Arith, Arith)
forall (m :: * -> *) e a b.
Monad m =>
Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
infixRP Text
op (Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP Parser Void Arith
rootP) (Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripStartP Parser Void Arith
rootP))
  unaryP :: Text -> (Arith -> Arith) -> Parser Void Arith
unaryP Text
op Arith -> Arith
f = Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
op ParserT Void Identity () -> Parser Void Arith -> Parser Void Arith
forall a b.
ParserT Void Identity a
-> ParserT Void Identity b -> ParserT Void Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Arith -> Arith) -> Parser Void Arith -> Parser Void Arith
forall a b.
(a -> b) -> ParserT Void Identity a -> ParserT Void Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arith -> Arith
f Parser Void Arith
rootP
  rootP :: Parser Void Arith
rootP =
    [Parser Void Arith] -> Parser Void Arith
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
      [ Label -> Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"add" (Text -> (Arith -> Arith -> Arith) -> Parser Void Arith
binaryP Text
"+" Arith -> Arith -> Arith
ArithAdd)
      , Label -> Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"sub" (Text -> (Arith -> Arith -> Arith) -> Parser Void Arith
binaryP Text
"-" Arith -> Arith -> Arith
ArithSub)
      , Label -> Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"mul" (Text -> (Arith -> Arith -> Arith) -> Parser Void Arith
binaryP Text
"*" Arith -> Arith -> Arith
ArithMul)
      , Label -> Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"neg" (Text -> (Arith -> Arith) -> Parser Void Arith
unaryP Text
"-" Arith -> Arith
ArithNeg)
      , Label -> Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"paren" (ParserT Void Identity ()
-> ParserT Void Identity ()
-> Parser Void Arith
-> Parser Void Arith
forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (ParserT Void Identity () -> ParserT Void Identity ()
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"(")) (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
")") (Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP Parser Void Arith
rootP))
      , Label -> Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"num" (Rational -> Arith
ArithNum (Rational -> Arith)
-> ParserT Void Identity Rational -> Parser Void Arith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Rational
forall (m :: * -> *) e. Monad m => ParserT e m Rational
decP)
      , Label -> Parser Void Arith -> Parser Void Arith
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"var" (Text -> Arith
ArithVar (Text -> Arith) -> ParserT Void Identity Text -> Parser Void Arith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Text
forall {e}. ParserT e Identity Text
identP)
      ]

-- | Leaves of S-expression trees
data Atom
  = AtomIdent !Text
  | AtomString !Text
  | AtomInt !Integer
  | AtomSci !Scientific
  deriving stock (Atom -> Atom -> Bool
(Atom -> Atom -> Bool) -> (Atom -> Atom -> Bool) -> Eq Atom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
/= :: Atom -> Atom -> Bool
Eq, Eq Atom
Eq Atom =>
(Atom -> Atom -> Ordering)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Atom)
-> (Atom -> Atom -> Atom)
-> Ord Atom
Atom -> Atom -> Bool
Atom -> Atom -> Ordering
Atom -> Atom -> Atom
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Atom -> Atom -> Ordering
compare :: Atom -> Atom -> Ordering
$c< :: Atom -> Atom -> Bool
< :: Atom -> Atom -> Bool
$c<= :: Atom -> Atom -> Bool
<= :: Atom -> Atom -> Bool
$c> :: Atom -> Atom -> Bool
> :: Atom -> Atom -> Bool
$c>= :: Atom -> Atom -> Bool
>= :: Atom -> Atom -> Bool
$cmax :: Atom -> Atom -> Atom
max :: Atom -> Atom -> Atom
$cmin :: Atom -> Atom -> Atom
min :: Atom -> Atom -> Atom
Ord, Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> String
(Int -> Atom -> ShowS)
-> (Atom -> String) -> ([Atom] -> ShowS) -> Show Atom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Atom -> ShowS
showsPrec :: Int -> Atom -> ShowS
$cshow :: Atom -> String
show :: Atom -> String
$cshowList :: [Atom] -> ShowS
showList :: [Atom] -> ShowS
Show)

-- | An S-expression
data Sexp
  = SexpAtom !Atom
  | SexpList !(Seq Sexp)
  deriving stock (Sexp -> Sexp -> Bool
(Sexp -> Sexp -> Bool) -> (Sexp -> Sexp -> Bool) -> Eq Sexp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sexp -> Sexp -> Bool
== :: Sexp -> Sexp -> Bool
$c/= :: Sexp -> Sexp -> Bool
/= :: Sexp -> Sexp -> Bool
Eq, Eq Sexp
Eq Sexp =>
(Sexp -> Sexp -> Ordering)
-> (Sexp -> Sexp -> Bool)
-> (Sexp -> Sexp -> Bool)
-> (Sexp -> Sexp -> Bool)
-> (Sexp -> Sexp -> Bool)
-> (Sexp -> Sexp -> Sexp)
-> (Sexp -> Sexp -> Sexp)
-> Ord Sexp
Sexp -> Sexp -> Bool
Sexp -> Sexp -> Ordering
Sexp -> Sexp -> Sexp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sexp -> Sexp -> Ordering
compare :: Sexp -> Sexp -> Ordering
$c< :: Sexp -> Sexp -> Bool
< :: Sexp -> Sexp -> Bool
$c<= :: Sexp -> Sexp -> Bool
<= :: Sexp -> Sexp -> Bool
$c> :: Sexp -> Sexp -> Bool
> :: Sexp -> Sexp -> Bool
$c>= :: Sexp -> Sexp -> Bool
>= :: Sexp -> Sexp -> Bool
$cmax :: Sexp -> Sexp -> Sexp
max :: Sexp -> Sexp -> Sexp
$cmin :: Sexp -> Sexp -> Sexp
min :: Sexp -> Sexp -> Sexp
Ord, Int -> Sexp -> ShowS
[Sexp] -> ShowS
Sexp -> String
(Int -> Sexp -> ShowS)
-> (Sexp -> String) -> ([Sexp] -> ShowS) -> Show Sexp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sexp -> ShowS
showsPrec :: Int -> Sexp -> ShowS
$cshow :: Sexp -> String
show :: Sexp -> String
$cshowList :: [Sexp] -> ShowS
showList :: [Sexp] -> ShowS
Show)

-- | A parser for S-expressions
sexpParser :: Parser Void Sexp
sexpParser :: Parser Void Sexp
sexpParser = Parser Void Sexp -> Parser Void Sexp
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripP Parser Void Sexp
rootP
 where
  identP :: ParserT e Identity Text
identP = (Char -> Bool) -> ParserT e Identity Text
forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhile1P Char -> Bool
isAlpha
  atomP :: ParserT Void Identity Atom
atomP =
    [ParserT Void Identity Atom] -> ParserT Void Identity Atom
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
      [ Label -> ParserT Void Identity Atom -> ParserT Void Identity Atom
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"ident" (Text -> Atom
AtomIdent (Text -> Atom)
-> ParserT Void Identity Text -> ParserT Void Identity Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Text
forall {e}. ParserT e Identity Text
identP)
      , Label -> ParserT Void Identity Atom -> ParserT Void Identity Atom
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"string" (Text -> Atom
AtomString (Text -> Atom)
-> ParserT Void Identity Text -> ParserT Void Identity Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Text
forall (m :: * -> *) e. Monad m => ParserT e m Text
doubleStrP)
      , Label -> ParserT Void Identity Atom -> ParserT Void Identity Atom
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"int" (Integer -> Atom
AtomInt (Integer -> Atom)
-> ParserT Void Identity Integer -> ParserT Void Identity Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
intP)
      , Label -> ParserT Void Identity Atom -> ParserT Void Identity Atom
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"sci" (Scientific -> Atom
AtomSci (Scientific -> Atom)
-> ParserT Void Identity Scientific -> ParserT Void Identity Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Scientific
forall (m :: * -> *) e. Monad m => ParserT e m Scientific
sciP)
      ]
  listP :: ParserT Void Identity (Seq Sexp)
listP = ParserT Void Identity ()
-> ParserT Void Identity ()
-> ParserT Void Identity (Seq Sexp)
-> ParserT Void Identity (Seq Sexp)
forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (ParserT Void Identity () -> ParserT Void Identity ()
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"(")) (Text -> ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
")") (ParserT Void Identity (Seq Sexp)
-> ParserT Void Identity (Seq Sexp)
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (ParserT Void Identity ()
-> Parser Void Sexp -> ParserT Void Identity (Seq Sexp)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepByP ParserT Void Identity ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P Parser Void Sexp
rootP))
  rootP :: Parser Void Sexp
rootP =
    [Parser Void Sexp] -> Parser Void Sexp
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
      [ Label -> Parser Void Sexp -> Parser Void Sexp
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"atom" (Atom -> Sexp
SexpAtom (Atom -> Sexp) -> ParserT Void Identity Atom -> Parser Void Sexp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Atom
atomP)
      , Label -> Parser Void Sexp -> Parser Void Sexp
forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"list" (Seq Sexp -> Sexp
SexpList (Seq Sexp -> Sexp)
-> ParserT Void Identity (Seq Sexp) -> Parser Void Sexp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity (Seq Sexp)
listP)
      ]