{-# Language GADTs, ScopedTypeVariables #-}
module Codec.Phaser.Permutation (
  Permutable,
  runPermutable,
  term
 ) where

import Codec.Phaser.Core
import Control.Applicative

data Permutable p c t a where
  Term :: Phase p c t a -> Permutable p c t a
  Filled :: a -> Permutable p c t a
  (:<*>) :: Permutable p c t (a -> b) -> Permutable p c t a -> Permutable p c t b
  (:<|>) :: Permutable p c t a -> Permutable p c t a -> Permutable p c t a
  Empty :: Permutable p c t a

instance Functor (Permutable p c t) where
  fmap :: forall a b. (a -> b) -> Permutable p c t a -> Permutable p c t b
fmap a -> b
f (Term Phase p c t a
p) = Phase p c t b -> Permutable p c t b
forall p c t a. Phase p c t a -> Permutable p c t a
Term ((a -> b) -> Phase p c t a -> Phase p c t b
forall a b. (a -> b) -> Phase p c t a -> Phase p c t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Phase p c t a
p)
  fmap a -> b
f (Filled a
a) = b -> Permutable p c t b
forall a p c t. a -> Permutable p c t a
Filled (a -> b
f a
a)
  fmap a -> b
f (Permutable p c t (a -> a)
l :<*> Permutable p c t a
r) = (((a -> a) -> a -> b)
-> Permutable p c t (a -> a) -> Permutable p c t (a -> b)
forall a b. (a -> b) -> Permutable p c t a -> Permutable p c t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> a) -> a -> b)
 -> Permutable p c t (a -> a) -> Permutable p c t (a -> b))
-> ((a -> b) -> (a -> a) -> a -> b)
-> (a -> b)
-> Permutable p c t (a -> a)
-> Permutable p c t (a -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f Permutable p c t (a -> a)
l Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
forall p c t a b.
Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
:<*> Permutable p c t a
r
  fmap a -> b
f (Permutable p c t a
l :<|> Permutable p c t a
r) = (a -> b) -> Permutable p c t a -> Permutable p c t b
forall a b. (a -> b) -> Permutable p c t a -> Permutable p c t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Permutable p c t a
l Permutable p c t b -> Permutable p c t b -> Permutable p c t b
forall p c t a.
Permutable p c t a -> Permutable p c t a -> Permutable p c t a
:<|> (a -> b) -> Permutable p c t a -> Permutable p c t b
forall a b. (a -> b) -> Permutable p c t a -> Permutable p c t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Permutable p c t a
r

instance Applicative (Permutable p c t) where
  pure :: forall a. a -> Permutable p c t a
pure = a -> Permutable p c t a
forall a p c t. a -> Permutable p c t a
Filled
  <*> :: forall a b.
Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
(<*>) = Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
forall p c t a b.
Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
(:<*>)

instance (Monoid p) =>Alternative (Permutable p c t) where
  empty :: forall a. Permutable p c t a
empty = Permutable p c t a
forall p c t a. Permutable p c t a
Empty
  <|> :: forall a.
Permutable p c t a -> Permutable p c t a -> Permutable p c t a
(<|>) = Permutable p c t a -> Permutable p c t a -> Permutable p c t a
forall p c t a.
Permutable p c t a -> Permutable p c t a -> Permutable p c t a
(:<|>)

-- | Create a 'Phase' which runs the constituent terms of the 'Permutable'
-- in every order in which they succeed, running a separator 'Phase' between
-- each term which consumes input.
runPermutable :: forall p c t a b . Monoid p => Phase p c t b -> Permutable p c t a -> Phase p c t a
runPermutable :: forall p c t a b.
Monoid p =>
Phase p c t b -> Permutable p c t a -> Phase p c t a
runPermutable Phase p c t b
sep = Permutable p c t a -> Phase p c t a
go0 where
  go0 :: Permutable p c t a -> Phase p c t a
go0 Permutable p c t a
p = Permutable p c t a -> Phase p c t a
forall x. Permutable p c t x -> Phase p c t x
resolve Permutable p c t a
p Phase p c t a -> Phase p c t a -> Phase p c t a
forall a. Phase p c t a -> Phase p c t a -> Phase p c t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Permutable p c t a -> Phase p c t (Permutable p c t a)
forall x. Permutable p c t x -> Phase p c t (Permutable p c t x)
fill1 Permutable p c t a
p Phase p c t (Permutable p c t a)
-> (Permutable p c t a -> Phase p c t a) -> Phase p c t a
forall a b. Phase p c t a -> (a -> Phase p c t b) -> Phase p c t b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Permutable p c t a -> Phase p c t a
go)
  go :: Permutable p c t a -> Phase p c t a
go Permutable p c t a
p = Permutable p c t a -> Phase p c t a
forall x. Permutable p c t x -> Phase p c t x
resolve Permutable p c t a
p Phase p c t a -> Phase p c t a -> Phase p c t a
forall a. Phase p c t a -> Phase p c t a -> Phase p c t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Phase p c t b
sep Phase p c t b
-> Phase p c t (Permutable p c t a)
-> Phase p c t (Permutable p c t a)
forall a b. Phase p c t a -> Phase p c t b -> Phase p c t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Permutable p c t a -> Phase p c t (Permutable p c t a)
forall x. Permutable p c t x -> Phase p c t (Permutable p c t x)
fill1 Permutable p c t a
p Phase p c t (Permutable p c t a)
-> (Permutable p c t a -> Phase p c t a) -> Phase p c t a
forall a b. Phase p c t a -> (a -> Phase p c t b) -> Phase p c t b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Permutable p c t a -> Phase p c t a
go)
  resolve :: Permutable p c t x -> Phase p c t x
  resolve :: forall x. Permutable p c t x -> Phase p c t x
resolve (Filled x
a) = x -> Phase p c t x
forall a. a -> Phase p c t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
a
  resolve (Permutable p c t (a -> x)
l :<*> Permutable p c t a
r) = Permutable p c t (a -> x) -> Phase p c t (a -> x)
forall x. Permutable p c t x -> Phase p c t x
resolve Permutable p c t (a -> x)
l Phase p c t (a -> x) -> Phase p c t a -> Phase p c t x
forall a b. Phase p c t (a -> b) -> Phase p c t a -> Phase p c t b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Permutable p c t a -> Phase p c t a
forall x. Permutable p c t x -> Phase p c t x
resolve Permutable p c t a
r
  resolve (Permutable p c t x
l :<|> Permutable p c t x
r) = Permutable p c t x -> Phase p c t x
forall x. Permutable p c t x -> Phase p c t x
resolve Permutable p c t x
l Phase p c t x -> Phase p c t x -> Phase p c t x
forall a. Phase p c t a -> Phase p c t a -> Phase p c t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Permutable p c t x -> Phase p c t x
forall x. Permutable p c t x -> Phase p c t x
resolve Permutable p c t x
r
  resolve Permutable p c t x
_ = Phase p c t x
forall a. Phase p c t a
forall (f :: * -> *) a. Alternative f => f a
empty
  fill1 :: Permutable p c t x -> Phase p c t (Permutable p c t x)
  fill1 :: forall x. Permutable p c t x -> Phase p c t (Permutable p c t x)
fill1 (Term Phase p c t x
p) = x -> Permutable p c t x
forall a p c t. a -> Permutable p c t a
Filled (x -> Permutable p c t x)
-> Phase p c t x -> Phase p c t (Permutable p c t x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Phase p c t x
p
  fill1 (Permutable p c t (a -> x)
l :<*> Permutable p c t a
r) = ((Permutable p c t (a -> x)
 -> Permutable p c t a -> Permutable p c t x)
-> Permutable p c t a
-> Permutable p c t (a -> x)
-> Permutable p c t x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Permutable p c t (a -> x)
-> Permutable p c t a -> Permutable p c t x
forall p c t a b.
Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
simplify Permutable p c t a
r (Permutable p c t (a -> x) -> Permutable p c t x)
-> Phase p c t (Permutable p c t (a -> x))
-> Phase p c t (Permutable p c t x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Permutable p c t (a -> x)
-> Phase p c t (Permutable p c t (a -> x))
forall x. Permutable p c t x -> Phase p c t (Permutable p c t x)
fill1 Permutable p c t (a -> x)
l) Phase p c t (Permutable p c t x)
-> Phase p c t (Permutable p c t x)
-> Phase p c t (Permutable p c t x)
forall a. Phase p c t a -> Phase p c t a -> Phase p c t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Permutable p c t (a -> x)
-> Permutable p c t a -> Permutable p c t x
forall p c t a b.
Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
simplify Permutable p c t (a -> x)
l (Permutable p c t a -> Permutable p c t x)
-> Phase p c t (Permutable p c t a)
-> Phase p c t (Permutable p c t x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Permutable p c t a -> Phase p c t (Permutable p c t a)
forall x. Permutable p c t x -> Phase p c t (Permutable p c t x)
fill1 Permutable p c t a
r)
  fill1 (Permutable p c t x
l :<|> Permutable p c t x
r) = Permutable p c t x -> Phase p c t (Permutable p c t x)
forall x. Permutable p c t x -> Phase p c t (Permutable p c t x)
fill1 Permutable p c t x
l Phase p c t (Permutable p c t x)
-> Phase p c t (Permutable p c t x)
-> Phase p c t (Permutable p c t x)
forall a. Phase p c t a -> Phase p c t a -> Phase p c t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Permutable p c t x -> Phase p c t (Permutable p c t x)
forall x. Permutable p c t x -> Phase p c t (Permutable p c t x)
fill1 Permutable p c t x
r
  fill1 Permutable p c t x
_ = Phase p c t (Permutable p c t x)
forall a. Phase p c t a
forall (f :: * -> *) a. Alternative f => f a
empty
  simplify :: Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
simplify (Filled a -> b
l) Permutable p c t a
r = (a -> b) -> Permutable p c t a -> Permutable p c t b
forall a b. (a -> b) -> Permutable p c t a -> Permutable p c t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
l Permutable p c t a
r
  simplify Permutable p c t (a -> b)
l  (Filled a
r) = ((a -> b) -> b) -> Permutable p c t (a -> b) -> Permutable p c t b
forall a b. (a -> b) -> Permutable p c t a -> Permutable p c t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
r) Permutable p c t (a -> b)
l
  simplify Permutable p c t (a -> b)
Empty Permutable p c t a
r = Permutable p c t b
forall p c t a. Permutable p c t a
Empty
  simplify Permutable p c t (a -> b)
l Permutable p c t a
Empty = Permutable p c t b
forall p c t a. Permutable p c t a
Empty
  simplify Permutable p c t (a -> b)
l Permutable p c t a
r = Permutable p c t (a -> b)
l Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
forall p c t a b.
Permutable p c t (a -> b)
-> Permutable p c t a -> Permutable p c t b
:<*> Permutable p c t a
r

term :: Phase p c t a -> Permutable p c t a
term :: forall p c t a. Phase p c t a -> Permutable p c t a
term = Phase p c t a -> Permutable p c t a
forall p c t a. Phase p c t a -> Permutable p c t a
Term