{-# LANGUAGE OverloadedStrings #-}
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_)
data Json
= JsonNull
| JsonString !Text
| JsonArray !(Seq Json)
| JsonObject !(Seq (Text, Json))
| JsonNum !Scientific
| JsonBool !Bool
deriving stock (Json -> Json -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Json -> Json -> Bool
$c/= :: Json -> Json -> Bool
== :: Json -> Json -> Bool
$c== :: Json -> Json -> Bool
Eq, Eq 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
min :: Json -> Json -> Json
$cmin :: Json -> Json -> Json
max :: Json -> Json -> Json
$cmax :: Json -> Json -> Json
>= :: Json -> Json -> Bool
$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
compare :: Json -> Json -> Ordering
$ccompare :: Json -> Json -> Ordering
Ord, Int -> Json -> ShowS
[Json] -> ShowS
Json -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Json] -> ShowS
$cshowList :: [Json] -> ShowS
show :: Json -> String
$cshow :: Json -> String
showsPrec :: Int -> Json -> ShowS
$cshowsPrec :: Int -> Json -> ShowS
Show)
jsonParser :: Parser Void Json
jsonParser :: Parser Void Json
jsonParser = 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 =
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
[ forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"null" forall {e}. ParserT e Identity Json
nullP
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"bool" forall {e}. ParserT e Identity Json
boolP
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"str" forall {e}. ParserT e Identity Json
strP
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"array" Parser Void Json
arrayP
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"object" Parser Void Json
objectP
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"num" forall {e}. ParserT e Identity Json
numP
]
boolP :: ParserT e Identity Json
boolP = Bool -> Json
JsonBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"false" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"true")
numP :: ParserT e Identity Json
numP = Scientific -> Json
JsonNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e. Monad m => ParserT e m Scientific
sciP
nullP :: ParserT e Identity Json
nullP = Json
JsonNull forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"null"
strP :: ParserT e Identity Json
strP = Text -> Json
JsonString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e. Monad m => ParserT e m Text
doubleStrP
arrayP :: Parser Void Json
arrayP = Seq Json -> Json
JsonArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"[")) (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"]") (forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepByP (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
",")) (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 <- forall (m :: * -> *) e. Monad m => ParserT e m Text
doubleStrP
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
":")
Json
v <- Parser Void Json
valP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
s, Json
v)
objectP :: Parser Void Json
objectP = Seq (Text, Json) -> Json
JsonObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"{")) (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"}") (forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepByP (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
",")) (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP ParserT Void Identity (Text, Json)
pairP))
data Arith
= ArithNum !Rational
| ArithVar !Text
| ArithNeg Arith
| ArithMul Arith Arith
| ArithAdd Arith Arith
| ArithSub Arith Arith
deriving stock (Arith -> Arith -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arith -> Arith -> Bool
$c/= :: Arith -> Arith -> Bool
== :: Arith -> Arith -> Bool
$c== :: Arith -> Arith -> Bool
Eq, Eq 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
min :: Arith -> Arith -> Arith
$cmin :: Arith -> Arith -> Arith
max :: Arith -> Arith -> Arith
$cmax :: Arith -> Arith -> Arith
>= :: Arith -> Arith -> Bool
$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
compare :: Arith -> Arith -> Ordering
$ccompare :: Arith -> Arith -> Ordering
Ord, Int -> Arith -> ShowS
[Arith] -> ShowS
Arith -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arith] -> ShowS
$cshowList :: [Arith] -> ShowS
show :: Arith -> String
$cshow :: Arith -> String
showsPrec :: Int -> Arith -> ShowS
$cshowsPrec :: Int -> Arith -> ShowS
Show)
arithParser :: Parser Void Arith
arithParser :: Parser Void Arith
arithParser = 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Arith -> Arith -> Arith
f) (forall (m :: * -> *) e a b.
Monad m =>
Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
infixRP Text
op (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP Parser Void Arith
rootP) (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 = forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
op forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 =
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
[ 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)
, 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)
, 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)
, 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)
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"paren" (forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"(")) (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
")") (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP Parser Void Arith
rootP))
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"num" (Rational -> Arith
ArithNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e. Monad m => ParserT e m Rational
decP)
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"var" (Text -> Arith
ArithVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {e}. ParserT e Identity Text
identP)
]
data Atom
= AtomIdent !Text
| AtomString !Text
| AtomInt !Integer
| AtomSci !Scientific
deriving stock (Atom -> Atom -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, Eq 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
min :: Atom -> Atom -> Atom
$cmin :: Atom -> Atom -> Atom
max :: Atom -> Atom -> Atom
$cmax :: Atom -> Atom -> Atom
>= :: Atom -> Atom -> Bool
$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
compare :: Atom -> Atom -> Ordering
$ccompare :: Atom -> Atom -> Ordering
Ord, Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Atom] -> ShowS
$cshowList :: [Atom] -> ShowS
show :: Atom -> String
$cshow :: Atom -> String
showsPrec :: Int -> Atom -> ShowS
$cshowsPrec :: Int -> Atom -> ShowS
Show)
data Sexp
= SexpAtom !Atom
| SexpList !(Seq Sexp)
deriving stock (Sexp -> Sexp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sexp -> Sexp -> Bool
$c/= :: Sexp -> Sexp -> Bool
== :: Sexp -> Sexp -> Bool
$c== :: Sexp -> Sexp -> Bool
Eq, Eq 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
min :: Sexp -> Sexp -> Sexp
$cmin :: Sexp -> Sexp -> Sexp
max :: Sexp -> Sexp -> Sexp
$cmax :: Sexp -> Sexp -> Sexp
>= :: Sexp -> Sexp -> Bool
$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
compare :: Sexp -> Sexp -> Ordering
$ccompare :: Sexp -> Sexp -> Ordering
Ord, Int -> Sexp -> ShowS
[Sexp] -> ShowS
Sexp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sexp] -> ShowS
$cshowList :: [Sexp] -> ShowS
show :: Sexp -> String
$cshow :: Sexp -> String
showsPrec :: Int -> Sexp -> ShowS
$cshowsPrec :: Int -> Sexp -> ShowS
Show)
sexpParser :: Parser Void Sexp
sexpParser :: Parser Void Sexp
sexpParser = 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 = forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhile1P Char -> Bool
isAlpha
atomP :: ParserT Void Identity Atom
atomP =
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
[ forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"ident" (Text -> Atom
AtomIdent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {e}. ParserT e Identity Text
identP)
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"string" (Text -> Atom
AtomString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e. Monad m => ParserT e m Text
doubleStrP)
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"int" (Integer -> Atom
AtomInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e. Monad m => ParserT e m Integer
intP)
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"sci" (Scientific -> Atom
AtomSci forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e. Monad m => ParserT e m Scientific
sciP)
]
listP :: ParserT Void Identity (Seq Sexp)
listP = forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
"(")) (forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ Text
")") (forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP (forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepByP forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P Parser Void Sexp
rootP))
rootP :: Parser Void Sexp
rootP =
forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP
[ forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"atom" (Atom -> Sexp
SexpAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity Atom
atomP)
, forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
"list" (Seq Sexp -> Sexp
SexpList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Void Identity (Seq Sexp)
listP)
]