{-# LANGUAGE CPP #-}
{-# 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
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
iso :: (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso :: (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso a -> b
f' b -> a
g' = ((a :- t) -> b :- t)
-> ((b :- t) -> a :- t) -> Grammar p (a :- t) (b :- t)
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (a :- t) -> b :- t
forall t. (a :- t) -> b :- t
f (b :- t) -> a :- t
forall t. (b :- t) -> a :- t
g
where
f :: (a :- t) -> b :- t
f (a
a :- t
t) = a -> b
f' a
a b -> t -> b :- t
forall h t. h -> t -> h :- t
:- t
t
g :: (b :- t) -> a :- t
g (b
b :- t
t) = b -> a
g' b
b a -> t -> a :- t
forall h t. h -> t -> h :- t
:- t
t
osi :: (b -> a) -> (a -> b) -> Grammar p (a :- t) (b :- t)
osi :: (b -> a) -> (a -> b) -> Grammar p (a :- t) (b :- t)
osi b -> a
f' a -> b
g' = ((a :- t) -> b :- t)
-> ((b :- t) -> a :- t) -> Grammar p (a :- t) (b :- t)
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (a :- t) -> b :- t
forall t. (a :- t) -> b :- t
g (b :- t) -> a :- t
forall t. (b :- t) -> a :- t
f
where
f :: (b :- t) -> a :- t
f (b
a :- t
t) = b -> a
f' b
a a -> t -> a :- t
forall h t. h -> t -> h :- t
:- t
t
g :: (a :- t) -> b :- t
g (a
b :- t
t) = a -> b
g' a
b b -> t -> b :- t
forall h t. h -> t -> h :- t
:- t
t
partialIso :: (a -> b) -> (b -> Either Mismatch a) -> Grammar p (a :- t) (b :- t)
partialIso :: (a -> b) -> (b -> Either Mismatch a) -> Grammar p (a :- t) (b :- t)
partialIso a -> b
f' b -> Either Mismatch a
g' = ((a :- t) -> b :- t)
-> ((b :- t) -> Either Mismatch (a :- t))
-> Grammar p (a :- t) (b :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (a :- t) -> b :- t
forall t. (a :- t) -> b :- t
f (b :- t) -> Either Mismatch (a :- t)
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 b -> t -> b :- t
forall h t. h -> t -> h :- t
:- t
t
g :: (b :- t) -> Either Mismatch (a :- t)
g (b
b :- t
t) = (a -> t -> a :- t
forall h t. h -> t -> h :- t
:- t
t) (a -> a :- t) -> Either Mismatch a -> Either Mismatch (a :- 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 :: (a -> Either Mismatch b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
partialOsi a -> Either Mismatch b
g' b -> a
f' = Grammar p (b :- t) (a :- t) -> Grammar p (a :- t) (b :- t)
forall p a b. Grammar p a b -> Grammar p b a
Flip (Grammar p (b :- t) (a :- t) -> Grammar p (a :- t) (b :- t))
-> Grammar p (b :- t) (a :- t) -> Grammar p (a :- t) (b :- t)
forall a b. (a -> b) -> a -> b
$ ((b :- t) -> a :- t)
-> ((a :- t) -> Either Mismatch (b :- t))
-> Grammar p (b :- t) (a :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso (b :- t) -> a :- t
forall t. (b :- t) -> a :- t
f (a :- t) -> Either Mismatch (b :- t)
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 a -> t -> a :- t
forall h t. h -> t -> h :- t
:- t
t
g :: (a :- t) -> Either Mismatch (b :- t)
g (a
b :- t
t) = (b -> t -> b :- t
forall h t. h -> t -> h :- t
:- t
t) (b -> b :- t) -> Either Mismatch b -> Either Mismatch (b :- 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 :: a -> (a -> Bool) -> (a -> Mismatch) -> Grammar p t (a :- t)
push a
a a -> Bool
p a -> Mismatch
e = (t -> a :- t)
-> ((a :- t) -> Either Mismatch t) -> Grammar p t (a :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso t -> a :- t
forall t. t -> a :- t
f (a :- t) -> Either Mismatch t
forall b. (a :- b) -> Either Mismatch b
g
where
f :: t -> a :- t
f t
t = a
a a -> t -> a :- t
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' = b -> Either Mismatch b
forall a b. b -> Either a b
Right b
t
| Bool
otherwise = Mismatch -> Either Mismatch b
forall a b. a -> Either a b
Left (Mismatch -> Either Mismatch b) -> Mismatch -> Either Mismatch b
forall a b. (a -> b) -> a -> b
$ a -> Mismatch
e a
a'
pair :: Grammar p (b :- a :- t) ((a, b) :- t)
pair :: Grammar p (b :- (a :- t)) ((a, b) :- t)
pair = ((b :- (a :- t)) -> (a, b) :- t)
-> (((a, b) :- t) -> b :- (a :- t))
-> Grammar p (b :- (a :- t)) ((a, b) :- t)
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso
(\(b
b :- a
a :- t
t) -> (a
a, b
b) (a, b) -> t -> (a, b) :- t
forall h t. h -> t -> h :- t
:- t
t)
(\((a
a, b
b) :- t
t) -> b
b b -> (a :- t) -> b :- (a :- t)
forall h t. h -> t -> h :- t
:- a
a a -> t -> a :- t
forall h t. h -> t -> h :- t
:- t
t)
cons :: Grammar p ([a] :- a :- t) ([a] :- t)
cons :: Grammar p ([a] :- (a :- t)) ([a] :- t)
cons = (([a] :- (a :- t)) -> [a] :- t)
-> (([a] :- t) -> Either Mismatch ([a] :- (a :- t)))
-> Grammar p ([a] :- (a :- t)) ([a] :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
(\([a]
lst :- a
el :- t
t) -> (a
ela -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
lst) [a] -> t -> [a] :- t
forall h t. h -> t -> h :- t
:- t
t)
(\([a]
lst :- t
t) ->
case [a]
lst of
[] -> Mismatch -> Either Mismatch ([a] :- (a :- t))
forall a b. a -> Either a b
Left (Text -> Mismatch
expected Text
"list element")
(a
el:[a]
rest) -> ([a] :- (a :- t)) -> Either Mismatch ([a] :- (a :- t))
forall a b. b -> Either a b
Right ([a]
rest [a] -> (a :- t) -> [a] :- (a :- t)
forall h t. h -> t -> h :- t
:- a
el a -> t -> a :- t
forall h t. h -> t -> h :- t
:- t
t))
nil :: Grammar p t ([a] :- t)
nil :: Grammar p t ([a] :- t)
nil = (t -> [a] :- t)
-> (([a] :- t) -> Either Mismatch t) -> Grammar p t ([a] :- t)
forall a b p. (a -> b) -> (b -> Either Mismatch a) -> Grammar p a b
PartialIso
(\t
t -> [] [a] -> t -> [a] :- t
forall h t. h -> t -> h :- t
:- t
t)
(\([a]
lst :- t
t) ->
case [a]
lst of
[] -> t -> Either Mismatch t
forall a b. b -> Either a b
Right t
t
(a
_el:[a]
_rest) -> Mismatch -> Either Mismatch t
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 :: Grammar p (a :- (b :- t)) (b :- (a :- t))
swap = ((a :- (b :- t)) -> b :- (a :- t))
-> ((b :- (a :- t)) -> a :- (b :- t))
-> Grammar p (a :- (b :- t)) (b :- (a :- t))
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso
(\(a
a :- b
b :- t
t) -> (b
b b -> (a :- t) -> b :- (a :- t)
forall h t. h -> t -> h :- t
:- a
a a -> t -> a :- t
forall h t. h -> t -> h :- t
:- t
t))
(\(b
b :- a
a :- t
t) -> (a
a a -> (b :- t) -> a :- (b :- t)
forall h t. h -> t -> h :- t
:- b
b b -> t -> b :- t
forall h t. h -> t -> h :- t
:- t
t))
insert :: (Eq k) => k -> Mismatch -> Grammar p (v :- [(k, v)] :- t) ([(k, v)] :- t)
insert :: k -> Mismatch -> Grammar p (v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insert k
k Mismatch
m = ((v :- ([(k, v)] :- t)) -> [(k, v)] :- t)
-> (([(k, v)] :- t) -> Either Mismatch (v :- ([(k, v)] :- t)))
-> Grammar p (v :- ([(k, v)] :- t)) ([(k, v)] :- t)
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) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
alist) [(k, v)] -> t -> [(k, v)] :- t
forall h t. h -> t -> h :- t
:- t
t)
(\([(k, v)]
alist :- t
t) ->
case k -> [(k, v)] -> Maybe (v, [(k, v)])
forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
popKey k
k [(k, v)]
alist of
Maybe (v, [(k, v)])
Nothing -> Mismatch -> Either Mismatch (v :- ([(k, v)] :- t))
forall a b. a -> Either a b
Left Mismatch
m
Just (v
v, [(k, v)]
alist') -> (v :- ([(k, v)] :- t)) -> Either Mismatch (v :- ([(k, v)] :- t))
forall a b. b -> Either a b
Right (v
v v -> ([(k, v)] :- t) -> v :- ([(k, v)] :- t)
forall h t. h -> t -> h :- t
:- [(k, v)]
alist' [(k, v)] -> t -> [(k, v)] :- t
forall h t. h -> t -> h :- t
:- t
t))
insertMay :: (Eq k) => k -> Grammar p (Maybe v :- [(k, v)] :- t) ([(k, v)] :- t)
insertMay :: k -> Grammar p (Maybe v :- ([(k, v)] :- t)) ([(k, v)] :- t)
insertMay k
k = ((Maybe v :- ([(k, v)] :- t)) -> [(k, v)] :- t)
-> (([(k, v)] :- t)
-> Either Mismatch (Maybe v :- ([(k, v)] :- t)))
-> Grammar p (Maybe v :- ([(k, v)] :- t)) ([(k, v)] :- t)
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) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
alist) [(k, v)] -> t -> [(k, v)] :- t
forall h t. h -> t -> h :- t
:- t
t
Maybe v
Nothing -> [(k, v)]
alist [(k, v)] -> t -> [(k, v)] :- t
forall h t. h -> t -> h :- t
:- t
t)
(\([(k, v)]
alist :- t
t) ->
case k -> [(k, v)] -> Maybe (v, [(k, v)])
forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
popKey k
k [(k, v)]
alist of
Maybe (v, [(k, v)])
Nothing -> (Maybe v :- ([(k, v)] :- t))
-> Either Mismatch (Maybe v :- ([(k, v)] :- t))
forall a b. b -> Either a b
Right (Maybe v
forall a. Maybe a
Nothing Maybe v -> ([(k, v)] :- t) -> Maybe v :- ([(k, v)] :- t)
forall h t. h -> t -> h :- t
:- [(k, v)]
alist [(k, v)] -> t -> [(k, v)] :- t
forall h t. h -> t -> h :- t
:- t
t)
Just (v
v, [(k, v)]
alist') -> (Maybe v :- ([(k, v)] :- t))
-> Either Mismatch (Maybe v :- ([(k, v)] :- t))
forall a b. b -> Either a b
Right (v -> Maybe v
forall a. a -> Maybe a
Just v
v Maybe v -> ([(k, v)] :- t) -> Maybe v :- ([(k, v)] :- t)
forall h t. h -> t -> h :- t
:- [(k, v)]
alist' [(k, v)] -> t -> [(k, v)] :- t
forall h t. h -> t -> h :- t
:- t
t))
popKey :: forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
popKey :: 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 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k' = (v, [(k, v)]) -> Maybe (v, [(k, v)])
forall a. a -> Maybe a
Just (v
v, [(k, v)] -> [(k, v)]
forall a. [a] -> [a]
reverse [(k, v)]
acc [(k, v)] -> [(k, v)] -> [(k, v)]
forall a. [a] -> [a] -> [a]
++ [(k, v)]
xs)
| Bool
otherwise = [(k, v)] -> [(k, v)] -> Maybe (v, [(k, v)])
go ((k, v)
x(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
acc) [(k, v)]
xs
go [(k, v)]
_ [] = Maybe (v, [(k, v)])
forall a. Maybe a
Nothing
toDefault :: (Eq a) => a -> Grammar p (Maybe a :- t) (a :- t)
toDefault :: a -> Grammar p (Maybe a :- t) (a :- t)
toDefault a
def = (Maybe a -> a)
-> (a -> Maybe a) -> Grammar p (Maybe a :- t) (a :- t)
forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso
(a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def)
(\a
val -> if a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
def then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
val)
sealed :: Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed :: Grammar p (a :- Void) (b :- Void) -> Grammar p a b
sealed Grammar p (a :- Void) (b :- Void)
g =
(a -> a :- Void) -> ((a :- Void) -> a) -> Grammar p a (a :- Void)
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (a -> Void -> a :- Void
forall h t. h -> t -> h :- t
:- [Char] -> Void
forall a. HasCallStack => [Char] -> a
error [Char]
"void") (\(a
a :- Void
_) -> a
a) Grammar p a (a :- Void) -> Grammar p (a :- Void) b -> Grammar p a b
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 Grammar p (a :- Void) (b :- Void)
-> Grammar p (b :- Void) b -> Grammar p (a :- Void) b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
((b :- Void) -> b) -> (b -> b :- Void) -> Grammar p (b :- Void) b
forall a b p. (a -> b) -> (b -> a) -> Grammar p a b
Iso (\(b
a :- Void
_) -> b
a) (b -> Void -> b :- Void
forall h t. h -> t -> h :- t
:- [Char] -> Void
forall a. HasCallStack => [Char] -> a
error [Char]
"void")
onHead :: Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead :: Grammar p a b -> Grammar p (a :- t) (b :- t)
onHead = Grammar p a b -> Grammar p (a :- t) (b :- t)
forall p a b a. Grammar p a b -> Grammar p (a :- a) (b :- a)
OnHead
onTail :: Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail :: Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
onTail = Grammar p ta tb -> Grammar p (h :- ta) (h :- tb)
forall p a b h. Grammar p a b -> Grammar p (h :- a) (h :- b)
OnTail
traversed :: (Traversable f) => Grammar p a b -> Grammar p (f a) (f b)
traversed :: Grammar p a b -> Grammar p (f a) (f b)
traversed = Grammar p a b -> Grammar p (f a) (f b)
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 :: Grammar p a b -> Grammar p b a
flipped = Grammar p a b -> Grammar p b a
forall p a b. Grammar p a b -> Grammar p b a
Flip
annotated :: Text -> Grammar p a b -> Grammar p a b
annotated :: Text -> Grammar p a b -> Grammar p a b
annotated = Text -> Grammar p a b -> Grammar p a b
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 :: Grammar p (a :- t) (b :- t') -> Grammar p (c :- t) (d :- t')
coerced Grammar p (a :- t) (b :- t')
g = (c -> a) -> (a -> c) -> Grammar p (c :- t) (a :- t)
forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso c -> a
coerce a -> c
coerce Grammar p (c :- t) (a :- t)
-> Grammar p (a :- t) (d :- t') -> Grammar p (c :- t) (d :- t')
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 Grammar p (a :- t) (b :- t')
-> Grammar p (b :- t') (d :- t') -> Grammar p (a :- t) (d :- t')
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (b -> d) -> (d -> b) -> Grammar p (b :- t') (d :- t')
forall a b p t. (a -> b) -> (b -> a) -> Grammar p (a :- t) (b :- t)
iso b -> d
coerce d -> b
coerce
coproduct :: [Grammar p a b] -> Grammar p a b
coproduct :: [Grammar p a b] -> Grammar p a b
coproduct = (Grammar p a b -> Grammar p a b -> Grammar p a b)
-> [Grammar p a b] -> Grammar p a b
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Grammar p a b -> Grammar p a b -> Grammar p a b
forall a. Semigroup a => a -> a -> a
(<>)