{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module UU.Parsing.Perms(Perms(), pPerms, pPermsSep, succeedPerms, (~*~), (~$~)) where
import UU.Parsing
import Data.Maybe
newtype Perms p a = Perms (Maybe (p a), [Br p a])
data Br p a = forall b. Br (Perms p (b -> a)) (p b)
instance IsParser p s => Functor (Perms p) where
fmap :: (a -> b) -> Perms p a -> Perms p b
fmap f :: a -> b
f (Perms (mb :: Maybe (p a)
mb, bs :: [Br p a]
bs)) = (Maybe (p b), [Br p b]) -> Perms p b
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms ((p a -> p b) -> Maybe (p a) -> Maybe (p b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f(a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Maybe (p a)
mb, (Br p a -> Br p b) -> [Br p a] -> [Br p b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Br p a -> Br p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Br p a]
bs)
instance IsParser p s => Functor (Br p) where
fmap :: (a -> b) -> Br p a -> Br p b
fmap f :: a -> b
f (Br perm :: Perms p (b -> a)
perm p :: p b
p) = Perms p (b -> b) -> p b -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br (((b -> a) -> b -> b) -> Perms p (b -> a) -> Perms p (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f(a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Perms p (b -> a)
perm) p b
p
(~*~) :: IsParser p s => Perms p (a -> b) -> p a -> Perms p b
perms :: Perms p (a -> b)
perms ~*~ :: Perms p (a -> b) -> p a -> Perms p b
~*~ p :: p a
p = Perms p (a -> b)
perms Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
forall (p :: * -> *) s a b.
IsParser p s =>
Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
`add` (p a -> Maybe (p a)
forall (p :: * -> *) s v. IsParser p s => p v -> Maybe (p v)
getzerop p a
p, p a -> Maybe (p a)
forall (p :: * -> *) s v. IsParser p s => p v -> Maybe (p v)
getonep p a
p)
(~$~) :: IsParser p s => (a -> b) -> p a -> Perms p b
f :: a -> b
f ~$~ :: (a -> b) -> p a -> Perms p b
~$~ p :: p a
p = (a -> b) -> Perms p (a -> b)
forall (p :: * -> *) s a. IsParser p s => a -> Perms p a
succeedPerms a -> b
f Perms p (a -> b) -> p a -> Perms p b
forall (p :: * -> *) s a b.
IsParser p s =>
Perms p (a -> b) -> p a -> Perms p b
~*~ p a
p
succeedPerms :: IsParser p s => a -> Perms p a
succeedPerms :: a -> Perms p a
succeedPerms x :: a
x = (Maybe (p a), [Br p a]) -> Perms p a
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms (p a -> Maybe (p a)
forall a. a -> Maybe a
Just (a -> p a
forall (p :: * -> *) s a. IsParser p s => a -> p a
pLow a
x), [])
add :: IsParser p s => Perms p (a -> b) -> (Maybe (p a),Maybe (p a)) -> Perms p b
add :: Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
add b2a :: Perms p (a -> b)
b2a@(Perms (eb2a :: Maybe (p (a -> b))
eb2a, nb2a :: [Br p (a -> b)]
nb2a)) bp :: (Maybe (p a), Maybe (p a))
bp@(eb :: Maybe (p a)
eb, nb :: Maybe (p a)
nb)
= let changing :: IsParser p s => (a -> b) -> Perms p a -> Perms p b
f :: a -> b
f changing :: (a -> b) -> Perms p a -> Perms p b
`changing` Perms (ep :: Maybe (p a)
ep, np :: [Br p a]
np) = (Maybe (p b), [Br p b]) -> Perms p b
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms ((p a -> p b) -> Maybe (p a) -> Maybe (p b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Maybe (p a)
ep, [Perms p (b -> b) -> p b -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br ((a -> b
f(a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((b -> a) -> b -> b) -> Perms p (b -> a) -> Perms p (b -> b)
forall (p :: * -> *) s a b.
IsParser p s =>
(a -> b) -> Perms p a -> Perms p b
`changing` Perms p (b -> a)
pp) p b
p | Br pp :: Perms p (b -> a)
pp p :: p b
p <- [Br p a]
np])
in (Maybe (p b), [Br p b]) -> Perms p b
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms
( do { p (a -> b)
f <- Maybe (p (a -> b))
eb2a
; p a
x <- Maybe (p a)
eb
; p b -> Maybe (p b)
forall (m :: * -> *) a. Monad m => a -> m a
return (p (a -> b)
f p (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a
x)
}
, (case Maybe (p a)
nb of
Nothing -> [Br p b] -> [Br p b]
forall a. a -> a
id
Just pb :: p a
pb -> (Perms p (a -> b) -> p a -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br Perms p (a -> b)
b2a p a
pbBr p b -> [Br p b] -> [Br p b]
forall a. a -> [a] -> [a]
:)
)[ Perms p (b -> b) -> p b -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br (((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> a -> b) -> a -> b -> b)
-> Perms p (b -> a -> b) -> Perms p (a -> b -> b)
forall (p :: * -> *) s a b.
IsParser p s =>
(a -> b) -> Perms p a -> Perms p b
`changing` Perms p (b -> a -> b)
c) Perms p (a -> b -> b)
-> (Maybe (p a), Maybe (p a)) -> Perms p (b -> b)
forall (p :: * -> *) s a b.
IsParser p s =>
Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
`add` (Maybe (p a), Maybe (p a))
bp) p b
d | Br c :: Perms p (b -> a -> b)
c d :: p b
d <- [Br p (a -> b)]
nb2a]
)
pPerms :: IsParser p s => Perms p a -> p a
pPerms :: Perms p a -> p a
pPerms (Perms (empty :: Maybe (p a)
empty,nonempty :: [Br p a]
nonempty))
= (p a -> p a -> p a) -> p a -> [p a] -> p a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl p a -> p a -> p a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (p a -> Maybe (p a) -> p a
forall a. a -> Maybe a -> a
fromMaybe p a
forall (p :: * -> *) s a. IsParser p s => p a
pFail Maybe (p a)
empty) [ (((b -> a) -> b -> a) -> b -> (b -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
($)) (b -> (b -> a) -> a) -> p b -> p ((b -> a) -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p b
p p ((b -> a) -> a) -> p (b -> a) -> p a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Perms p (b -> a) -> p (b -> a)
forall (p :: * -> *) s a. IsParser p s => Perms p a -> p a
pPerms Perms p (b -> a)
pp
| Br pp :: Perms p (b -> a)
pp p :: p b
p <- [Br p a]
nonempty
]
pPermsSep :: IsParser p s => p x -> Perms p a -> p a
pPermsSep :: p x -> Perms p a -> p a
pPermsSep (p x
sep :: p z) perm :: Perms p a
perm = p () -> Perms p a -> p a
forall a. p () -> Perms p a -> p a
p2p (() -> p ()
forall (p :: * -> *) s a. IsParser p s => a -> p a
pSucceed ()) Perms p a
perm
where p2p :: p () -> Perms p a -> p a
p2p :: p () -> Perms p a -> p a
p2p fsep :: p ()
fsep (Perms (mbempty :: Maybe (p a)
mbempty, nonempties :: [Br p a]
nonempties)) =
let empty :: p a
empty = p a -> Maybe (p a) -> p a
forall a. a -> Maybe a -> a
fromMaybe p a
forall (p :: * -> *) s a. IsParser p s => p a
pFail Maybe (p a)
mbempty
pars :: Br p a -> p a
pars (Br t :: Perms p (b -> a)
t p :: p b
p) = ((b -> a) -> b -> a) -> b -> (b -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
($) (b -> (b -> a) -> a) -> p () -> p (b -> (b -> a) -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ p ()
fsep p (b -> (b -> a) -> a) -> p b -> p ((b -> a) -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p b
p p ((b -> a) -> a) -> p (b -> a) -> p a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Perms p (b -> a) -> p (b -> a)
forall a. Perms p a -> p a
p2p_sep Perms p (b -> a)
t
in (p a -> p a -> p a) -> p a -> [p a] -> p a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr p a -> p a -> p a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) p a
empty ((Br p a -> p a) -> [Br p a] -> [p a]
forall a b. (a -> b) -> [a] -> [b]
map Br p a -> p a
forall a. Br p a -> p a
pars [Br p a]
nonempties)
p2p_sep :: Perms p a -> p a
p2p_sep = p () -> Perms p a -> p a
forall a. p () -> Perms p a -> p a
p2p (()() -> p x -> p ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ p x
sep)