{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Automaton.Final where

-- base
import Control.Applicative (Alternative)
import Control.Arrow
import Control.Category
import Prelude hiding (id, (.))

-- transformers
import Control.Monad.Trans.Reader

-- automaton
import Data.Automaton
import Data.Stream.Final qualified as StreamFinal
import Data.Stream.Optimized qualified as StreamOptimized

-- | Automata in final encoding.
newtype Final m a b = Final {forall (m :: Type -> Type) a b.
Final m a b -> Final (ReaderT a m) b
getFinal :: StreamFinal.Final (ReaderT a m) b}
  deriving newtype ((forall a b. (a -> b) -> Final m a a -> Final m a b)
-> (forall a b. a -> Final m a b -> Final m a a)
-> Functor (Final m a)
forall a b. a -> Final m a b -> Final m a a
forall a b. (a -> b) -> Final m a a -> Final m a b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: Type -> Type) a a b.
Functor m =>
a -> Final m a b -> Final m a a
forall (m :: Type -> Type) a a b.
Functor m =>
(a -> b) -> Final m a a -> Final m a b
$cfmap :: forall (m :: Type -> Type) a a b.
Functor m =>
(a -> b) -> Final m a a -> Final m a b
fmap :: forall a b. (a -> b) -> Final m a a -> Final m a b
$c<$ :: forall (m :: Type -> Type) a a b.
Functor m =>
a -> Final m a b -> Final m a a
<$ :: forall a b. a -> Final m a b -> Final m a a
Functor, Functor (Final m a)
Functor (Final m a) =>
(forall a. a -> Final m a a)
-> (forall a b. Final m a (a -> b) -> Final m a a -> Final m a b)
-> (forall a b c.
    (a -> b -> c) -> Final m a a -> Final m a b -> Final m a c)
-> (forall a b. Final m a a -> Final m a b -> Final m a b)
-> (forall a b. Final m a a -> Final m a b -> Final m a a)
-> Applicative (Final m a)
forall a. a -> Final m a a
forall a b. Final m a a -> Final m a b -> Final m a a
forall a b. Final m a a -> Final m a b -> Final m a b
forall a b. Final m a (a -> b) -> Final m a a -> Final m a b
forall a b c.
(a -> b -> c) -> Final m a a -> Final m a b -> Final m a c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: Type -> Type) a. Applicative m => Functor (Final m a)
forall (m :: Type -> Type) a a. Applicative m => a -> Final m a a
forall (m :: Type -> Type) a a b.
Applicative m =>
Final m a a -> Final m a b -> Final m a a
forall (m :: Type -> Type) a a b.
Applicative m =>
Final m a a -> Final m a b -> Final m a b
forall (m :: Type -> Type) a a b.
Applicative m =>
Final m a (a -> b) -> Final m a a -> Final m a b
forall (m :: Type -> Type) a a b c.
Applicative m =>
(a -> b -> c) -> Final m a a -> Final m a b -> Final m a c
$cpure :: forall (m :: Type -> Type) a a. Applicative m => a -> Final m a a
pure :: forall a. a -> Final m a a
$c<*> :: forall (m :: Type -> Type) a a b.
Applicative m =>
Final m a (a -> b) -> Final m a a -> Final m a b
<*> :: forall a b. Final m a (a -> b) -> Final m a a -> Final m a b
$cliftA2 :: forall (m :: Type -> Type) a a b c.
Applicative m =>
(a -> b -> c) -> Final m a a -> Final m a b -> Final m a c
liftA2 :: forall a b c.
(a -> b -> c) -> Final m a a -> Final m a b -> Final m a c
$c*> :: forall (m :: Type -> Type) a a b.
Applicative m =>
Final m a a -> Final m a b -> Final m a b
*> :: forall a b. Final m a a -> Final m a b -> Final m a b
$c<* :: forall (m :: Type -> Type) a a b.
Applicative m =>
Final m a a -> Final m a b -> Final m a a
<* :: forall a b. Final m a a -> Final m a b -> Final m a a
Applicative, Applicative (Final m a)
Applicative (Final m a) =>
(forall a. Final m a a)
-> (forall a. Final m a a -> Final m a a -> Final m a a)
-> (forall a. Final m a a -> Final m a [a])
-> (forall a. Final m a a -> Final m a [a])
-> Alternative (Final m a)
forall a. Final m a a
forall a. Final m a a -> Final m a [a]
forall a. Final m a a -> Final m a a -> Final m a a
forall (f :: Type -> Type).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: Type -> Type) a.
Alternative m =>
Applicative (Final m a)
forall (m :: Type -> Type) a a. Alternative m => Final m a a
forall (m :: Type -> Type) a a.
Alternative m =>
Final m a a -> Final m a [a]
forall (m :: Type -> Type) a a.
Alternative m =>
Final m a a -> Final m a a -> Final m a a
$cempty :: forall (m :: Type -> Type) a a. Alternative m => Final m a a
empty :: forall a. Final m a a
$c<|> :: forall (m :: Type -> Type) a a.
Alternative m =>
Final m a a -> Final m a a -> Final m a a
<|> :: forall a. Final m a a -> Final m a a -> Final m a a
$csome :: forall (m :: Type -> Type) a a.
Alternative m =>
Final m a a -> Final m a [a]
some :: forall a. Final m a a -> Final m a [a]
$cmany :: forall (m :: Type -> Type) a a.
Alternative m =>
Final m a a -> Final m a [a]
many :: forall a. Final m a a -> Final m a [a]
Alternative)

instance (Monad m) => Category (Final m) where
  id :: forall a. Final m a a
id = Automaton m a a -> Final m a a
forall (m :: Type -> Type) a b.
Functor m =>
Automaton m a b -> Final m a b
toFinal Automaton m a a
forall a. Automaton m a a
forall {k} (cat :: k -> k -> Type) (a :: k).
Category cat =>
cat a a
id
  Final m b c
f1 . :: forall b c a. Final m b c -> Final m a b -> Final m a c
. Final m a b
f2 = Automaton m a c -> Final m a c
forall (m :: Type -> Type) a b.
Functor m =>
Automaton m a b -> Final m a b
toFinal (Automaton m a c -> Final m a c) -> Automaton m a c -> Final m a c
forall a b. (a -> b) -> a -> b
$ Final m b c -> Automaton m b c
forall (m :: Type -> Type) a b. Final m a b -> Automaton m a b
fromFinal Final m b c
f1 Automaton m b c -> Automaton m a b -> Automaton m a c
forall b c a. Automaton m b c -> Automaton m a b -> Automaton m a c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Final m a b -> Automaton m a b
forall (m :: Type -> Type) a b. Final m a b -> Automaton m a b
fromFinal Final m a b
f2

instance (Monad m) => Arrow (Final m) where
  arr :: forall b c. (b -> c) -> Final m b c
arr = Automaton m b c -> Final m b c
forall (m :: Type -> Type) a b.
Functor m =>
Automaton m a b -> Final m a b
toFinal (Automaton m b c -> Final m b c)
-> ((b -> c) -> Automaton m b c) -> (b -> c) -> Final m b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> c) -> Automaton m b c
forall b c. (b -> c) -> Automaton m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr
  first :: forall b c d. Final m b c -> Final m (b, d) (c, d)
first = Automaton m (b, d) (c, d) -> Final m (b, d) (c, d)
forall (m :: Type -> Type) a b.
Functor m =>
Automaton m a b -> Final m a b
toFinal (Automaton m (b, d) (c, d) -> Final m (b, d) (c, d))
-> (Final m b c -> Automaton m (b, d) (c, d))
-> Final m b c
-> Final m (b, d) (c, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Automaton m b c -> Automaton m (b, d) (c, d)
forall b c d. Automaton m b c -> Automaton m (b, d) (c, d)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Automaton m b c -> Automaton m (b, d) (c, d))
-> (Final m b c -> Automaton m b c)
-> Final m b c
-> Automaton m (b, d) (c, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Final m b c -> Automaton m b c
forall (m :: Type -> Type) a b. Final m a b -> Automaton m a b
fromFinal

toFinal :: (Functor m) => Automaton m a b -> Final m a b
toFinal :: forall (m :: Type -> Type) a b.
Functor m =>
Automaton m a b -> Final m a b
toFinal (Automaton OptimizedStreamT (ReaderT a m) b
automaton) = Final (ReaderT a m) b -> Final m a b
forall (m :: Type -> Type) a b.
Final (ReaderT a m) b -> Final m a b
Final (Final (ReaderT a m) b -> Final m a b)
-> Final (ReaderT a m) b -> Final m a b
forall a b. (a -> b) -> a -> b
$ OptimizedStreamT (ReaderT a m) b -> Final (ReaderT a m) b
forall (m :: Type -> Type) a.
Functor m =>
OptimizedStreamT m a -> Final m a
StreamOptimized.toFinal OptimizedStreamT (ReaderT a m) b
automaton

fromFinal :: Final m a b -> Automaton m a b
fromFinal :: forall (m :: Type -> Type) a b. Final m a b -> Automaton m a b
fromFinal Final {Final (ReaderT a m) b
getFinal :: forall (m :: Type -> Type) a b.
Final m a b -> Final (ReaderT a m) b
getFinal :: Final (ReaderT a m) b
getFinal} = OptimizedStreamT (ReaderT a m) b -> Automaton m a b
forall (m :: Type -> Type) a b.
OptimizedStreamT (ReaderT a m) b -> Automaton m a b
Automaton (OptimizedStreamT (ReaderT a m) b -> Automaton m a b)
-> OptimizedStreamT (ReaderT a m) b -> Automaton m a b
forall a b. (a -> b) -> a -> b
$ Final (ReaderT a m) b -> OptimizedStreamT (ReaderT a m) b
forall (m :: Type -> Type) a. Final m a -> OptimizedStreamT m a
StreamOptimized.fromFinal Final (ReaderT a m) b
getFinal