{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Data.SCargot.Repr.WellFormed
(
R.WellFormedSExpr(..)
, R.toWellFormed
, R.fromWellFormed
, cons
, uncons
, pattern (:::)
, pattern L
, pattern A
, pattern Nil
, fromPair
, fromList
, fromAtom
, asPair
, asList
, isAtom
, isNil
, asAtom
, asAssoc
, car
, cdr
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>), pure)
#endif
import Data.SCargot.Repr as R
uncons :: WellFormedSExpr a -> Maybe (WellFormedSExpr a, WellFormedSExpr a)
uncons :: forall a.
WellFormedSExpr a -> Maybe (WellFormedSExpr a, WellFormedSExpr a)
uncons R.WFSAtom {} = Maybe (WellFormedSExpr a, WellFormedSExpr a)
forall a. Maybe a
Nothing
uncons (R.WFSList []) = Maybe (WellFormedSExpr a, WellFormedSExpr a)
forall a. Maybe a
Nothing
uncons (R.WFSList (WellFormedSExpr a
x:[WellFormedSExpr a]
xs)) = (WellFormedSExpr a, WellFormedSExpr a)
-> Maybe (WellFormedSExpr a, WellFormedSExpr a)
forall a. a -> Maybe a
Just (WellFormedSExpr a
x, [WellFormedSExpr a] -> WellFormedSExpr a
forall atom. [WellFormedSExpr atom] -> WellFormedSExpr atom
R.WFSList [WellFormedSExpr a]
xs)
cons :: WellFormedSExpr a -> WellFormedSExpr a -> Maybe (WellFormedSExpr a)
cons :: forall a.
WellFormedSExpr a -> WellFormedSExpr a -> Maybe (WellFormedSExpr a)
cons WellFormedSExpr a
_ (R.WFSAtom {}) = Maybe (WellFormedSExpr a)
forall a. Maybe a
Nothing
cons WellFormedSExpr a
x (R.WFSList [WellFormedSExpr a]
xs) = WellFormedSExpr a -> Maybe (WellFormedSExpr a)
forall a. a -> Maybe a
Just ([WellFormedSExpr a] -> WellFormedSExpr a
forall atom. [WellFormedSExpr atom] -> WellFormedSExpr atom
R.WFSList (WellFormedSExpr a
xWellFormedSExpr a -> [WellFormedSExpr a] -> [WellFormedSExpr a]
forall a. a -> [a] -> [a]
:[WellFormedSExpr a]
xs))
#if MIN_VERSION_base(4,8,0)
pattern (:::) :: WellFormedSExpr a -> WellFormedSExpr a -> WellFormedSExpr a
#endif
pattern x $m::: :: forall {r} {a}.
WellFormedSExpr a
-> (WellFormedSExpr a -> WellFormedSExpr a -> r)
-> ((# #) -> r)
-> r
::: xs <- (uncons -> Just (x, xs))
#if MIN_VERSION_base(4,8,0)
pattern L :: [WellFormedSExpr t] -> WellFormedSExpr t
#endif
pattern $mL :: forall {r} {t}.
WellFormedSExpr t
-> ([WellFormedSExpr t] -> r) -> ((# #) -> r) -> r
$bL :: forall atom. [WellFormedSExpr atom] -> WellFormedSExpr atom
L xs = R.WFSList xs
#if MIN_VERSION_base(4,8,0)
pattern A :: t -> WellFormedSExpr t
#endif
pattern $mA :: forall {r} {t}. WellFormedSExpr t -> (t -> r) -> ((# #) -> r) -> r
$bA :: forall t. t -> WellFormedSExpr t
A a = R.WFSAtom a
#if MIN_VERSION_base(4,8,0)
pattern Nil :: WellFormedSExpr t
#endif
pattern $mNil :: forall {r} {t}.
WellFormedSExpr t -> ((# #) -> r) -> ((# #) -> r) -> r
$bNil :: forall t. WellFormedSExpr t
Nil = R.WFSList []
getShape :: WellFormedSExpr a -> String
getShape :: forall a. WellFormedSExpr a -> String
getShape WFSAtom {} = String
"atom"
getShape (WFSList []) = String
"empty list"
getShape (WFSList [WellFormedSExpr a]
sx) = String
"list of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([WellFormedSExpr a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WellFormedSExpr a]
sx)
fromPair :: (WellFormedSExpr t -> Either String a)
-> (WellFormedSExpr t -> Either String b)
-> WellFormedSExpr t -> Either String (a, b)
fromPair :: forall t a b.
(WellFormedSExpr t -> Either String a)
-> (WellFormedSExpr t -> Either String b)
-> WellFormedSExpr t
-> Either String (a, b)
fromPair WellFormedSExpr t -> Either String a
pl WellFormedSExpr t -> Either String b
pr (L [WellFormedSExpr t
l, WellFormedSExpr t
r]) = (,) (a -> b -> (a, b))
-> Either String a -> Either String (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WellFormedSExpr t -> Either String a
pl WellFormedSExpr t
l Either String (b -> (a, b))
-> Either String b -> Either String (a, b)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WellFormedSExpr t -> Either String b
pr WellFormedSExpr t
r
fromPair WellFormedSExpr t -> Either String a
_ WellFormedSExpr t -> Either String b
_ WellFormedSExpr t
sx = String -> Either String (a, b)
forall a b. a -> Either a b
Left (String
"fromPair: expected two-element list; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
fromList :: (WellFormedSExpr t -> Either String a)
-> WellFormedSExpr t -> Either String [a]
fromList :: forall t a.
(WellFormedSExpr t -> Either String a)
-> WellFormedSExpr t -> Either String [a]
fromList WellFormedSExpr t -> Either String a
p (L [WellFormedSExpr t]
ss) = (WellFormedSExpr t -> Either String a)
-> [WellFormedSExpr t] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM WellFormedSExpr t -> Either String a
p [WellFormedSExpr t]
ss
fromList WellFormedSExpr t -> Either String a
_ WellFormedSExpr t
sx = String -> Either String [a]
forall a b. a -> Either a b
Left (String
"fromList: expected list; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
fromAtom :: WellFormedSExpr t -> Either String t
fromAtom :: forall t. WellFormedSExpr t -> Either String t
fromAtom (A t
a) = t -> Either String t
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return t
a
fromAtom WellFormedSExpr t
sx = String -> Either String t
forall a b. a -> Either a b
Left (String
"fromAtom: expected atom; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
asPair :: ((WellFormedSExpr t, WellFormedSExpr t) -> Either String a)
-> WellFormedSExpr t -> Either String a
asPair :: forall t a.
((WellFormedSExpr t, WellFormedSExpr t) -> Either String a)
-> WellFormedSExpr t -> Either String a
asPair (WellFormedSExpr t, WellFormedSExpr t) -> Either String a
f (L [WellFormedSExpr t
l, WellFormedSExpr t
r]) = (WellFormedSExpr t, WellFormedSExpr t) -> Either String a
f (WellFormedSExpr t
l, WellFormedSExpr t
r)
asPair (WellFormedSExpr t, WellFormedSExpr t) -> Either String a
_ WellFormedSExpr t
sx = String -> Either String a
forall a b. a -> Either a b
Left (String
"asPair: expected two-element list; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
asList :: ([WellFormedSExpr t] -> Either String a)
-> WellFormedSExpr t -> Either String a
asList :: forall t a.
([WellFormedSExpr t] -> Either String a)
-> WellFormedSExpr t -> Either String a
asList [WellFormedSExpr t] -> Either String a
f (L [WellFormedSExpr t]
ls) = [WellFormedSExpr t] -> Either String a
f [WellFormedSExpr t]
ls
asList [WellFormedSExpr t] -> Either String a
_ WellFormedSExpr t
sx = String -> Either String a
forall a b. a -> Either a b
Left (String
"asList: expected list; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
isAtom :: Eq t => t -> WellFormedSExpr t -> Either String ()
isAtom :: forall t. Eq t => t -> WellFormedSExpr t -> Either String ()
isAtom t
s (A t
s')
| t
s t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
s' = () -> Either String ()
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = String -> Either String ()
forall a b. a -> Either a b
Left String
"isAtom: failed to match atom"
isAtom t
_ WellFormedSExpr t
sx = String -> Either String ()
forall a b. a -> Either a b
Left (String
"isAtom: expected atom; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
isNil :: WellFormedSExpr t -> Either String ()
isNil :: forall t. WellFormedSExpr t -> Either String ()
isNil WellFormedSExpr t
Nil = () -> Either String ()
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isNil WellFormedSExpr t
sx = String -> Either String ()
forall a b. a -> Either a b
Left (String
"isNil: expected nil; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
asAtom :: (t -> Either String a) -> WellFormedSExpr t -> Either String a
asAtom :: forall t a.
(t -> Either String a) -> WellFormedSExpr t -> Either String a
asAtom t -> Either String a
f (A t
s) = t -> Either String a
f t
s
asAtom t -> Either String a
_ WellFormedSExpr t
sx = String -> Either String a
forall a b. a -> Either a b
Left (String
"asAtom: expected atom; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
asAssoc :: ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
-> WellFormedSExpr t -> Either String a
asAssoc :: forall t a.
([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
-> WellFormedSExpr t -> Either String a
asAssoc [(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a
f (L [WellFormedSExpr t]
ss) = [WellFormedSExpr t]
-> Either String [(WellFormedSExpr t, WellFormedSExpr t)]
forall {a}.
[WellFormedSExpr a]
-> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
gatherPairs [WellFormedSExpr t]
ss Either String [(WellFormedSExpr t, WellFormedSExpr t)]
-> ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
-> Either String a
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a
f
where gatherPairs :: [WellFormedSExpr a]
-> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
gatherPairs (L [WellFormedSExpr a
a, WellFormedSExpr a
b] : [WellFormedSExpr a]
ts) = (:) ((WellFormedSExpr a, WellFormedSExpr a)
-> [(WellFormedSExpr a, WellFormedSExpr a)]
-> [(WellFormedSExpr a, WellFormedSExpr a)])
-> Either String (WellFormedSExpr a, WellFormedSExpr a)
-> Either
String
([(WellFormedSExpr a, WellFormedSExpr a)]
-> [(WellFormedSExpr a, WellFormedSExpr a)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WellFormedSExpr a, WellFormedSExpr a)
-> Either String (WellFormedSExpr a, WellFormedSExpr a)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WellFormedSExpr a
a, WellFormedSExpr a
b) Either
String
([(WellFormedSExpr a, WellFormedSExpr a)]
-> [(WellFormedSExpr a, WellFormedSExpr a)])
-> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
-> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [WellFormedSExpr a]
-> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
gatherPairs [WellFormedSExpr a]
ts
gatherPairs [] = [(WellFormedSExpr a, WellFormedSExpr a)]
-> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
gatherPairs (WellFormedSExpr a
sx:[WellFormedSExpr a]
_) = String -> Either String [(WellFormedSExpr a, WellFormedSExpr a)]
forall a b. a -> Either a b
Left (String
"asAssoc: expected pair; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr a -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr a
sx)
asAssoc [(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a
_ WellFormedSExpr t
sx = String -> Either String a
forall a b. a -> Either a b
Left (String
"asAssoc: expected list; found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WellFormedSExpr t -> String
forall a. WellFormedSExpr a -> String
getShape WellFormedSExpr t
sx)
car :: (WellFormedSExpr t -> Either String t')
-> [WellFormedSExpr t] -> Either String t'
car :: forall t t'.
(WellFormedSExpr t -> Either String t')
-> [WellFormedSExpr t] -> Either String t'
car WellFormedSExpr t -> Either String t'
f (WellFormedSExpr t
x:[WellFormedSExpr t]
_) = WellFormedSExpr t -> Either String t'
f WellFormedSExpr t
x
car WellFormedSExpr t -> Either String t'
_ [] = String -> Either String t'
forall a b. a -> Either a b
Left String
"car: Taking car of zero-element list"
cdr :: ([WellFormedSExpr t] -> Either String t')
-> [WellFormedSExpr t] -> Either String t'
cdr :: forall t t'.
([WellFormedSExpr t] -> Either String t')
-> [WellFormedSExpr t] -> Either String t'
cdr [WellFormedSExpr t] -> Either String t'
f (WellFormedSExpr t
_:[WellFormedSExpr t]
xs) = [WellFormedSExpr t] -> Either String t'
f [WellFormedSExpr t]
xs
cdr [WellFormedSExpr t] -> Either String t'
_ [] = String -> Either String t'
forall a b. a -> Either a b
Left String
"cdr: Taking cdr of zero-element list"