{-# LANGUAGE FlexibleInstances, Rank2Types #-}

module Math.Semimeasure.Process where

import Control.Arrow (first, second)
import Control.Monad.Identity
import Control.Monad.Trans.Cont
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
import Control.Proxy hiding (execState, tell, StateT, WriterT)
import Data.Monoid
import System.IO.Unsafe

import Math.Semimeasure.Bit

newtype Process a = Process {
  runProcess :: (Proxy p, Monad m, Eq a) => () -> Pipe p Bit a m ()
}

instance Monoid (Process Bit) where
  mempty = Process idT
  mappend a b = Process $ runProcess a >-> runProcess b

toFunction :: (Eq a) => Process a -> [Bit] -> [a]
toFunction pcs input =
  execWriter $ runProxy pipeline where
    pipeline = fromListS input >-> runProcess pcs >-> toListLazyD

foldLazyD :: (Proxy p, Monad m, Monoid w) =>
             (a -> w) -> a' -> p a' a a' a (WriterT w m) r
foldLazyD f = runIdentityK go where
  go a' = do
    a   <- request a'
    lift $ tell (f a)
    a'2 <- respond a
    go a'2

toListLazyD :: (Proxy p, Monad m) =>
               a' -> p a' a a' a (WriterT [a] m) r
toListLazyD = foldLazyD (\a -> [a])
