{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
module Data.InvertibleGrammar.Combinators
( iso
, osi
, partialIso
, partialOsi
, push
, pair
, swap
, cons
, nil
, insert
, insertMay
, toDefault
, coproduct
, onHead
, onTail
, traversed
, flipped
, sealed
, coerced
, annotated
) where
import Control.Category ((>>>))
import Data.Coerce
import Data.Maybe
import Data.Void
import Data.Text (Text)
import Data.InvertibleGrammar.Base
iso :: (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso :: forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso a -> b
f' b -> a
g' = forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso forall {t}. (a :- t) -> b :- t
f forall {t}. (b :- t) -> a :- t
g
where
f :: (a :- t) -> b :- t
f (a
a :- t
t) = a -> b
f' a
a forall h t. h -> t -> h :- t
:- t
t
g :: (b :- t) -> a :- t
g (b
b :- t
t) = b -> a
g' b
b forall h t. h -> t -> h :- t
:- t
t
osi :: (b -> a) -> (a -> b) -> Grammar p (a :- t) (b :- t)
osi :: forall b a p t. (b -> a) -> (a -> b) -> Grammar p (a :- t) (b :- t)
osi b -> a
f' a -> b
g' = forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso forall {t}. (a :- t) -> b :- t
g forall {t}. (b :- t) -> a :- t
f
where
f :: (b :- t) -> a :- t
f (b
a :- t
t) = b -> a
f' b
a forall h t. h -> t -> h :- t
:- t
t
g :: (a :- t) -> b :- t
g (a
b :- t
t) = a -> b
g' a
b forall h t. h -> t -> h :- t
:- t
t
partialIso :: (a -> b) -> (b -> Either Mismatch a) -> Grammar p (a :- t) (b :- t)
partialIso :: forall a b p t.
(a -> b) -> (b -> Either Mismatch a) -> Grammar p (a :- t) (b :- t)
partialIso a -> b
f' b -> Either Mismatch a
g' = forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso forall {t}. (a :- t) -> b :- t
f forall {t}. (b :- t) -> Either Mismatch (a :- t)
g
where
f :: (a :- t) -> b :- t
f (a
a :- t
t) = a -> b
f' a
a forall h t. h -> t -> h :- t
:- t
t
g :: (b :- t) -> Either Mismatch (a :- t)
g (b
b :- t
t) = (forall h t. h -> t -> h :- t
:- t
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> Either Mismatch a
g' b
b
partialOsi :: (a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi :: forall a b p t.
(a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi a -> Either Mismatch b
g' b -> a
f' = forall p b a. Grammar p b a -> Grammar p a b
Flip forall a b. (a -> b) -> a -> b
$ forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso forall {t}. (b :- t) -> a :- t
f forall {t}. (a :- t) -> Either Mismatch (b :- t)
g
where
f :: (b :- t) -> a :- t
f (b
a :- t
t) = b -> a
f' b
a forall h t. h -> t -> h :- t
:- t
t
g :: (a :- t) -> Either Mismatch (b :- t)
g (a
b :- t
t) = (forall h t. h -> t -> h :- t
:- t
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Either Mismatch b
g' a
b
push :: a -> (a -> Bool) -> (a -> Mismatch) -> Grammar p t (a :- t)
push :: forall a p t.
a -> (a -> Bool) -> (a -> Mismatch) -> Grammar p t (a :- t)
push a
a a -> Bool
p a -> Mismatch
e = forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso forall {t}. t -> a :- t
f forall {b}. (a :- b) -> Either Mismatch b
g
where
f :: t -> a :- t
f t
t = a
a forall h t. h -> t -> h :- t
:- t
t
g :: (a :- b) -> Either Mismatch b
g (a
a' :- b
t)
| a -> Bool
p a
a' = forall a b. b -> Either a b
Right b
t
| Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ a -> Mismatch
e a
a'
pair :: Grammar p (b :- a :- t) ((a, b) :- t)
pair :: forall p b a t. Grammar p (b :- (a :- t)) ((a, b) :- t)
pair = forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso
(\(b
b :- a
a :- t
t) -> (a
a, b
b) forall h t. h -> t -> h :- t
:- t
t)
(\((a
a, b
b) :- t
t) -> b
b forall h t. h -> t -> h :- t
:- a
a forall h t. h -> t -> h :- t
:- t
t)
cons :: Grammar p ([a] :- a :- t) ([a] :- t)
cons :: forall p a t. Grammar p ([a] :- (a :- t)) ([a] :- t)
cons = forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
(\([a]
lst :- a
el :- t
t) -> (a
elforall a. a -> [a] -> [a]
:[a]
lst) forall h t. h -> t -> h :- t
:- t
t)
(\([a]
lst :- t
t) ->
case [a]
lst of
[] -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"list element")
(a
el:[a]
rest) -> forall a b. b -> Either a b
Right ([a]
rest forall h t. h -> t -> h :- t
:- a
el forall h t. h -> t -> h :- t
:- t
t))
nil :: Grammar p t ([a] :- t)
nil :: forall p t a. Grammar p t ([a] :- t)
nil = forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
(\t
t -> [] forall h t. h -> t -> h :- t
:- t
t)
(\([a]
lst :- t
t) ->
case [a]
lst of
[] -> forall a b. b -> Either a b
Right t
t
(a
_el:[a]
_rest) -> forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"end of list"))
swap :: Grammar p (a :- b :- t) (b :- a :- t)
swap :: forall p a b t. Grammar p (a :- (b :- t)) (b :- (a :- t))
swap = forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso
(\(a
a :- b
b :- t
t) -> (b
b forall h t. h -> t -> h :- t
:- a
a forall h t. h -> t -> h :- t
:- t
t))
(\(b
b :- a
a :- t
t) -> (a
a forall h t. h -> t -> h :- t
:- b
b forall h t. h -> t -> h :- t
:- t
t))
insert :: (Eq k) => k -> Mismatch -> Grammar p (v :- [(k, v)] :- t) ([(k, v)] :- t)
insert :: forall k p v t.
Eq k =>
k -> Mismatch -> Grammar p (v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insert k
k Mismatch
m = forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
(\(v
v :- [(k, v)]
alist :- t
t) -> ((k
k, v
v) forall a. a -> [a] -> [a]
: [(k, v)]
alist) forall h t. h -> t -> h :- t
:- t
t)
(\([(k, v)]
alist :- t
t) ->
case forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
popKey k
k [(k, v)]
alist of
Maybe (v, [(k, v)])
Nothing -> forall a b. a -> Either a b
Left Mismatch
m
Just (v
v, [(k, v)]
alist') -> forall a b. b -> Either a b
Right (v
v forall h t. h -> t -> h :- t
:- [(k, v)]
alist' forall h t. h -> t -> h :- t
:- t
t))
insertMay :: (Eq k) => k -> Grammar p (Maybe v :- [(k, v)] :- t) ([(k, v)] :- t)
insertMay :: forall k p v t.
Eq k =>
k -> Grammar p (Maybe v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insertMay k
k = forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
(\(Maybe v
mv :- [(k, v)]
alist :- t
t) ->
case Maybe v
mv of
Just v
v -> ((k
k, v
v) forall a. a -> [a] -> [a]
: [(k, v)]
alist) forall h t. h -> t -> h :- t
:- t
t
Maybe v
Nothing -> [(k, v)]
alist forall h t. h -> t -> h :- t
:- t
t)
(\([(k, v)]
alist :- t
t) ->
case forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
popKey k
k [(k, v)]
alist of
Maybe (v, [(k, v)])
Nothing -> forall a b. b -> Either a b
Right (forall a. Maybe a
Nothing forall h t. h -> t -> h :- t
:- [(k, v)]
alist forall h t. h -> t -> h :- t
:- t
t)
Just (v
v, [(k, v)]
alist') -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just v
v forall h t. h -> t -> h :- t
:- [(k, v)]
alist' forall h t. h -> t -> h :- t
:- t
t))
popKey :: forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
popKey :: forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
popKey k
k' = [(k, v)] -> [(k, v)] -> Maybe (v, [(k, v)])
go []
where
go :: [(k, v)] -> [(k, v)] -> Maybe (v, [(k, v)])
go :: [(k, v)] -> [(k, v)] -> Maybe (v, [(k, v)])
go [(k, v)]
acc (x :: (k, v)
x@(k
k, v
v) : [(k, v)]
xs)
| k
k forall a. Eq a => a -> a -> Bool
== k
k' = forall a. a -> Maybe a
Just (v
v, forall a. [a] -> [a]
reverse [(k, v)]
acc forall a. [a] -> [a] -> [a]
++ [(k, v)]
xs)
| Bool
otherwise = [(k, v)] -> [(k, v)] -> Maybe (v, [(k, v)])
go ((k, v)
xforall a. a -> [a] -> [a]
:[(k, v)]
acc) [(k, v)]
xs
go [(k, v)]
_ [] = forall a. Maybe a
Nothing
toDefault :: (Eq a) => a -> Grammar p (Maybe a :- t) (a :- t)
toDefault :: forall a p t. Eq a => a -> Grammar p (Maybe a :- t) (a :- t)
toDefault a
def = forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso
(forall a. a -> Maybe a -> a
fromMaybe a
def)
(\a
val -> if a
val forall a. Eq a => a -> a -> Bool
== a
def then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
val)
sealed :: Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed :: forall p a b. Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed Grammar p (a :- Void) (b :- Void)
g =
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (forall h t. h -> t -> h :- t
:- forall a. HasCallStack => [Char] -> a
error [Char]
"void") (\(a
a :- Void
_) -> a
a) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
Grammar p (a :- Void) (b :- Void)
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (\(b
a :- Void
_) -> b
a) (forall h t. h -> t -> h :- t
:- forall a. HasCallStack => [Char] -> a
error [Char]
"void")
onHead :: Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead :: forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead = forall p a b t. Grammar p a b -> Grammar p (a :- t) (b :- t)
OnHead
onTail :: Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail :: forall p ta tb h. Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail = forall p ta tb h. Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
OnTail
traversed :: (Traversable f) => Grammar p a b -> Grammar p (f a) (f b)
traversed :: forall (f :: * -> *) p a b.
Traversable f =>
Grammar p a b -> Grammar p (f a) (f b)
traversed = forall (f :: * -> *) p a b.
Traversable f =>
Grammar p a b -> Grammar p (f a) (f b)
Traverse
flipped :: Grammar p a b -> Grammar p b a
flipped :: forall p b a. Grammar p b a -> Grammar p a b
flipped = forall p b a. Grammar p b a -> Grammar p a b
Flip
annotated :: Text -> Grammar p a b -> Grammar p a b
annotated :: forall p a b. Text -> Grammar p a b -> Grammar p a b
annotated = forall p a b. Text -> Grammar p a b -> Grammar p a b
Annotate
coerced
:: (Coercible a c, Coercible b d) =>
Grammar p (a :- t) (b :- t')
-> Grammar p (c :- t) (d :- t')
coerced :: forall a c b d p t t'.
(Coercible a c, Coercible b d) =>
Grammar p (a :- t) (b :- t') -> Grammar p (c :- t) (d :- t')
coerced Grammar p (a :- t) (b :- t')
g = forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso coerce :: forall a b. Coercible a b => a -> b
coerce coerce :: forall a b. Coercible a b => a -> b
coerce forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar p (a :- t) (b :- t')
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso coerce :: forall a b. Coercible a b => a -> b
coerce coerce :: forall a b. Coercible a b => a -> b
coerce
coproduct :: [Grammar p a b] -> Grammar p a b
coproduct :: forall p a b. [Grammar p a b] -> Grammar p a b
coproduct = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Semigroup a => a -> a -> a
(<>)