{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

module ReWire.Interactive where
--         ( runStateT , runReacT , binary ) where

-- import Prelude hiding (head, (<>), (==), (-), (^), (&&), (||))

import qualified Control.Monad.Identity as GHC
import qualified Control.Monad.Resumption.Reactive as GHC
import qualified Control.Monad.State as GHC
import qualified Data.Vector.Sized as V

type Vec n a = V.Vector n a
-- type Bit = Bool

class ShowHex w where
  xshow :: w -> String

class ShowBin w where
  bshow :: w -> String

class ShowDec w where
  dshow :: w -> String

instance ShowDec (Vec n Bool) where
  dshow :: Vec n Bool -> String
dshow = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Vec n Bool -> Int) -> Vec n Bool -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec n Bool -> Int
forall (n :: Nat). Vec n Bool -> Int
fromBits
   where
     fromBits :: Vec n Bool -> Int
     fromBits :: forall (n :: Nat). Vec n Bool -> Int
fromBits Vec n Bool
v = Int -> Int -> [Bool] -> Int
gorf Int
0 Int
0 ([Bool] -> [Bool]
forall a. [a] -> [a]
reverse (Vec n Bool -> [Bool]
forall (n :: Nat) a. Vector n a -> [a]
V.toList Vec n Bool
v))

     gorf :: Int -> Int -> [Bool] -> Int
     gorf :: Int -> Int -> [Bool] -> Int
gorf Int
_ Int
acc []           = Int
acc
     gorf Int
n Int
acc (Bool
True : [Bool]
bs)  = Int -> Int -> [Bool] -> Int
gorf (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
Prelude.^ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc) [Bool]
bs
     gorf Int
n Int
acc (Bool
False : [Bool]
bs) = Int -> Int -> [Bool] -> Int
gorf (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
acc [Bool]
bs

instance ShowBin (Vec n Bool) where
  bshow :: Vec n Bool -> String
bshow Vec n Bool
bs = String
"0b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Bool -> Char) -> [Bool] -> String
forall a b. (a -> b) -> [a] -> [b]
map Bool -> Char
bool2bit (Vec n Bool -> [Bool]
forall (n :: Nat) a. Vector n a -> [a]
V.toList Vec n Bool
bs))
   where
     bool2bit :: Bool -> Char
     bool2bit :: Bool -> Char
bool2bit Bool
True  = Char
'1'
     bool2bit Bool
False = Char
'0'

instance ShowHex (Vec n Bool) where
  xshow :: Vec n Bool -> String
xshow Vec n Bool
bs = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Bool] -> String
hexify (Vec n Bool -> [Bool]
forall (n :: Nat) a. Vector n a -> [a]
V.toList Vec n Bool
bs)
   where
     hexify :: [Bool] -> String
     hexify :: [Bool] -> String
hexify [Bool]
bits = ((Bool, Bool, Bool, Bool) -> Char)
-> [(Bool, Bool, Bool, Bool)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Bool, Bool, Bool) -> Char
toHex ([(Bool, Bool, Bool, Bool)] -> [(Bool, Bool, Bool, Bool)]
forall a. [a] -> [a]
reverse (Bool -> [Bool] -> [(Bool, Bool, Bool, Bool)]
forall a. a -> [a] -> [(a, a, a, a)]
fours Bool
False ([Bool] -> [Bool]
forall a. [a] -> [a]
reverse [Bool]
bits)))
     fours :: a -> [a] -> [(a,a,a,a)]
     fours :: forall a. a -> [a] -> [(a, a, a, a)]
fours a
_ []                       = []
     fours a
d (a
x1 : a
x2 : a
x3 : a
x4 : [a]
xs) = (a
x4 , a
x3 , a
x2 , a
x1) (a, a, a, a) -> [(a, a, a, a)] -> [(a, a, a, a)]
forall a. a -> [a] -> [a]
: a -> [a] -> [(a, a, a, a)]
forall a. a -> [a] -> [(a, a, a, a)]
fours a
d [a]
xs
     fours a
d (a
x1 : a
x2 : a
x3 : [])      = (a
d , a
x3 , a
x2 , a
x1) (a, a, a, a) -> [(a, a, a, a)] -> [(a, a, a, a)]
forall a. a -> [a] -> [a]
: []
     fours a
d (a
x1 : a
x2 : [])           = (a
d , a
d , a
x2 , a
x1) (a, a, a, a) -> [(a, a, a, a)] -> [(a, a, a, a)]
forall a. a -> [a] -> [a]
: []
     fours a
d (a
x1 : [])                = (a
d , a
d , a
d , a
x1) (a, a, a, a) -> [(a, a, a, a)] -> [(a, a, a, a)]
forall a. a -> [a] -> [a]
: []

     toHex :: (Bool , Bool , Bool , Bool) -> Char
     toHex :: (Bool, Bool, Bool, Bool) -> Char
toHex (Bool
False , Bool
False , Bool
False , Bool
False) = Char
'0'
     toHex (Bool
False , Bool
False , Bool
False , Bool
True)  = Char
'1'
     toHex (Bool
False , Bool
False , Bool
True , Bool
False)  = Char
'2'
     toHex (Bool
False , Bool
False , Bool
True , Bool
True)   = Char
'3'
     toHex (Bool
False , Bool
True , Bool
False , Bool
False)  = Char
'4'
     toHex (Bool
False , Bool
True , Bool
False , Bool
True)   = Char
'5'
     toHex (Bool
False , Bool
True , Bool
True , Bool
False)   = Char
'6'
     toHex (Bool
False , Bool
True , Bool
True , Bool
True)    = Char
'7'
     toHex (Bool
True , Bool
False , Bool
False , Bool
False)  = Char
'8'
     toHex (Bool
True , Bool
False , Bool
False , Bool
True)   = Char
'9'
     toHex (Bool
True , Bool
False , Bool
True , Bool
False)   = Char
'A'
     toHex (Bool
True , Bool
False , Bool
True , Bool
True)    = Char
'B'
     toHex (Bool
True , Bool
True , Bool
False , Bool
False)   = Char
'C'
     toHex (Bool
True , Bool
True , Bool
False , Bool
True)    = Char
'D'
     toHex (Bool
True , Bool
True , Bool
True , Bool
False)    = Char
'E'
     toHex (Bool
True , Bool
True , Bool
True , Bool
True)     = Char
'F'

binary :: Vec n Bool -> IO ()
binary :: forall (n :: Nat). Vec n Bool -> IO ()
binary = String -> IO ()
putStrLn (String -> IO ()) -> (Vec n Bool -> String) -> Vec n Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec n Bool -> String
forall w. ShowBin w => w -> String
bshow

hex :: Vec n Bool -> IO ()
hex :: forall (n :: Nat). Vec n Bool -> IO ()
hex = String -> IO ()
putStrLn (String -> IO ()) -> (Vec n Bool -> String) -> Vec n Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec n Bool -> String
forall w. ShowHex w => w -> String
xshow

dec :: Vec n Bool -> IO ()
dec :: forall (n :: Nat). Vec n Bool -> IO ()
dec = String -> IO ()
putStrLn (String -> IO ()) -> (Vec n Bool -> String) -> Vec n Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec n Bool -> String
forall w. ShowDec w => w -> String
dshow

{- -}

runIdentity :: GHC.Identity a -> a
runIdentity :: forall a. Identity a -> a
runIdentity (GHC.Identity a
x) = a
x

runStateT :: GHC.StateT s m a -> s -> m (a , s)
runStateT :: forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (GHC.StateT s -> m (a, s)
x) = s -> m (a, s)
x

runReacT :: GHC.ReacT i o m a -> m (Either a (o , i -> GHC.ReacT i o m a))
runReacT :: forall i o (m :: * -> *) a.
ReacT i o m a -> m (Either a (o, i -> ReacT i o m a))
runReacT (GHC.ReacT m (Either a (o, i -> ReacT i o m a))
x) = m (Either a (o, i -> ReacT i o m a))
x

pretty :: Pretty a => a -> IO ()
pretty :: forall a. Pretty a => a -> IO ()
pretty a
a = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Pretty a => a -> String
pp a
a

class Pretty a where
  pp :: a -> String

instance Pretty (V.Vector n Bool) where
  pp :: Vector n Bool -> String
pp Vector n Bool
bs = Vector n Bool -> String
forall w. ShowHex w => w -> String
xshow Vector n Bool
bs

instance (Pretty a, Pretty b) => Pretty (a , b) where
  pp :: (a, b) -> String
pp (a
a , b
b) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pp a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
pp b
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Pretty a, Pretty b , Pretty c) => Pretty (a , b , c) where
  pp :: (a, b, c) -> String
pp (a
a , b
b , c
c) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pp a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
pp b
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Pretty a => a -> String
pp c
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Pretty a, Pretty b , Pretty c, Pretty d) => Pretty (a , b , c, d) where
  pp :: (a, b, c, d) -> String
pp (a
a,b
b,c
c,d
d) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pp a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
pp b
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Pretty a => a -> String
pp c
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ d -> String
forall a. Pretty a => a -> String
pp d
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f,Pretty g,Pretty h) => Pretty (a,b,c,d,e,f,g,h) where
  pp :: (a, b, c, d, e, f, g, h) -> String
pp (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pp a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
pp b
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Pretty a => a -> String
pp c
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ d -> String
forall a. Pretty a => a -> String
pp d
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
","
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Pretty a => a -> String
pp e
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ f -> String
forall a. Pretty a => a -> String
pp f
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ g -> String
forall a. Pretty a => a -> String
pp g
g String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ h -> String
forall a. Pretty a => a -> String
pp h
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f,Pretty g,Pretty h,
          Pretty i,Pretty j,Pretty k,Pretty l,Pretty m,Pretty n,Pretty o,Pretty p) => Pretty (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where
  pp :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) -> String
pp (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p) =
      String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pp a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
pp b
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Pretty a => a -> String
pp c
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ d -> String
forall a. Pretty a => a -> String
pp d
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
","
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Pretty a => a -> String
pp e
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ f -> String
forall a. Pretty a => a -> String
pp f
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ g -> String
forall a. Pretty a => a -> String
pp g
g String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ h -> String
forall a. Pretty a => a -> String
pp h
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
","
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ i -> String
forall a. Pretty a => a -> String
pp i
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ j -> String
forall a. Pretty a => a -> String
pp j
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Pretty a => a -> String
pp k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ l -> String
forall a. Pretty a => a -> String
pp l
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
","
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ m -> String
forall a. Pretty a => a -> String
pp m
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ n -> String
forall a. Pretty a => a -> String
pp n
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ o -> String
forall a. Pretty a => a -> String
pp o
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Pretty a => a -> String
pp p
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance Pretty () where
  pp :: () -> String
pp () = String
"()"

instance Pretty Bool where
  pp :: Bool -> String
pp = Bool -> String
forall a. Show a => a -> String
show

instance Pretty Integer where
  pp :: Integer -> String
pp = Integer -> String
forall a. Show a => a -> String
show

instance Pretty a => Pretty (Maybe a) where
  pp :: Maybe a -> String
pp Maybe a
Nothing = String
"Nothing"
  pp (Just a
a) = String
"Just " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pp a
a

instance Pretty a => Pretty [a] where
  pp :: [a] -> String
pp []       = String
"[]"
  pp (a
x : [a]
xs) = a -> String
forall a. Pretty a => a -> String
pp a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Pretty a => a -> String
pp [a]
xs

instance (Pretty w , Pretty a) => Pretty (WriterPlus w a) where
  pp :: WriterPlus w a -> String
pp (w
w :> WriterPlus w a
ws) = w -> String
forall a. Pretty a => a -> String
pp w
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WriterPlus w a -> String
forall a. Pretty a => a -> String
pp WriterPlus w a
ws
  pp (w
w :+> a
a) = w -> String
forall a. Pretty a => a -> String
pp w
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :+> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pp a
a

type Re i s o a   = GHC.ReacT i o (GHC.StateT s GHC.Identity) a
type RePure i o a = GHC.ReacT i o GHC.Identity a

step :: Re i s o a -> i -> s -> Either (a , s) (Re i s o a , s , o)
step :: forall i s o a.
Re i s o a -> i -> s -> Either (a, s) (Re i s o a, s, o)
step (GHC.ReacT StateT
  s Identity (Either a (o, i -> ReacT i o (StateT s Identity) a))
x) i
i' s
s = case Identity (Either a (o, i -> ReacT i o (StateT s Identity) a), s)
-> (Either a (o, i -> ReacT i o (StateT s Identity) a), s)
forall a. Identity a -> a
GHC.runIdentity (StateT
  s Identity (Either a (o, i -> ReacT i o (StateT s Identity) a))
-> s
-> Identity (Either a (o, i -> ReacT i o (StateT s Identity) a), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT  StateT
  s Identity (Either a (o, i -> ReacT i o (StateT s Identity) a))
x s
s) of
                             (Left a
a , s
si)         -> (a, s) -> Either (a, s) (ReacT i o (StateT s Identity) a, s, o)
forall a b. a -> Either a b
Left (a
a , s
si)
                             (Right (o
o' , i -> ReacT i o (StateT s Identity) a
k) , s
s') -> (ReacT i o (StateT s Identity) a, s, o)
-> Either (a, s) (ReacT i o (StateT s Identity) a, s, o)
forall a b. b -> Either a b
Right (i -> ReacT i o (StateT s Identity) a
k i
i' , s
s' , o
o')

stepPure :: RePure i o a -> i -> Either a (RePure i o a , o)
stepPure :: forall i o a. RePure i o a -> i -> Either a (RePure i o a, o)
stepPure (GHC.ReacT Identity (Either a (o, i -> ReacT i o Identity a))
x) i
i' = case Identity (Either a (o, i -> ReacT i o Identity a))
-> Either a (o, i -> ReacT i o Identity a)
forall a. Identity a -> a
GHC.runIdentity Identity (Either a (o, i -> ReacT i o Identity a))
x of
                                 (Left a
a)         -> a -> Either a (ReacT i o Identity a, o)
forall a b. a -> Either a b
Left a
a
                                 (Right (o
o' , i -> ReacT i o Identity a
k)) -> (ReacT i o Identity a, o) -> Either a (ReacT i o Identity a, o)
forall a b. b -> Either a b
Right (i -> ReacT i o Identity a
k i
i' , o
o')

iterRe :: (i -> Re i s o a) -> i -> s -> Either (a, s) (i -> Re i s o a, s, o)
iterRe :: forall i s o a.
(i -> Re i s o a)
-> i -> s -> Either (a, s) (i -> Re i s o a, s, o)
iterRe i -> Re i s o a
f i
i' s
s = case Identity (Either a (o, i -> Re i s o a), s)
-> (Either a (o, i -> Re i s o a), s)
forall a. Identity a -> a
GHC.runIdentity (StateT s Identity (Either a (o, i -> Re i s o a))
-> s -> Identity (Either a (o, i -> Re i s o a), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Re i s o a -> StateT s Identity (Either a (o, i -> Re i s o a))
forall i o (m :: * -> *) a.
ReacT i o m a -> m (Either a (o, i -> ReacT i o m a))
runReacT (i -> Re i s o a
f i
i')) s
s) of
                     (Left a
a , s
si)         -> (a, s) -> Either (a, s) (i -> Re i s o a, s, o)
forall a b. a -> Either a b
Left (a
a , s
si)
                     (Right (o
o' , i -> Re i s o a
k) , s
s') -> (i -> Re i s o a, s, o) -> Either (a, s) (i -> Re i s o a, s, o)
forall a b. b -> Either a b
Right (i -> Re i s o a
k  , s
s' , o
o')

grunt :: (i -> Re i s o a) -> (i , s , o) -> [i] -> WriterPlus (i , s , o) (Maybe (a , i , s))
grunt :: forall i s o a.
(i -> Re i s o a)
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
grunt i -> Re i s o a
_ (i
i0 , s
s0 , o
o0) []      = (i
i0 , s
s0 , o
o0) (i, s, o)
-> Maybe (a, i, s) -> WriterPlus (i, s, o) (Maybe (a, i, s))
forall w a. w -> a -> WriterPlus w a
:+> Maybe (a, i, s)
forall a. Maybe a
Nothing
grunt i -> Re i s o a
f (i
i0, s
s0, o
o0) (i
i' : [i]
is) = case (i -> Re i s o a)
-> i -> s -> Either (a, s) (i -> Re i s o a, s, o)
forall i s o a.
(i -> Re i s o a)
-> i -> s -> Either (a, s) (i -> Re i s o a, s, o)
iterRe i -> Re i s o a
f i
i0 s
s0 of
                                       Left (a
a , s
si)       -> (i
i0 , s
s0 , o
o0) (i, s, o)
-> Maybe (a, i, s) -> WriterPlus (i, s, o) (Maybe (a, i, s))
forall w a. w -> a -> WriterPlus w a
:+> (a, i, s) -> Maybe (a, i, s)
forall a. a -> Maybe a
Just (a
a , i
i' , s
si)
                                       Right (i -> Re i s o a
k , s
s' , o
o') -> (i
i0 , s
s0 , o
o0) (i, s, o)
-> WriterPlus (i, s, o) (Maybe (a, i, s))
-> WriterPlus (i, s, o) (Maybe (a, i, s))
forall w a. w -> WriterPlus w a -> WriterPlus w a
:> (i -> Re i s o a)
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
forall i s o a.
(i -> Re i s o a)
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
grunt i -> Re i s o a
k (i
i' , s
s' , o
o') [i]
is


run :: Re i s o a -> (i , s , o) -> [i] -> WriterPlus (i , s , o) (Maybe (a , i , s))
run :: forall i s o a.
Re i s o a
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
run Re i s o a
_ (i
i0, s
s0, o
o0) []        = (i
i0 , s
s0 , o
o0) (i, s, o)
-> Maybe (a, i, s) -> WriterPlus (i, s, o) (Maybe (a, i, s))
forall w a. w -> a -> WriterPlus w a
:+> Maybe (a, i, s)
forall a. Maybe a
Nothing
run Re i s o a
x (i
i0, s
s0, o
o0) (i
i' : [i]
is) = case Re i s o a -> i -> s -> Either (a, s) (Re i s o a, s, o)
forall i s o a.
Re i s o a -> i -> s -> Either (a, s) (Re i s o a, s, o)
step Re i s o a
x i
i' s
s0 of
                                       Left (a
a , s
si)        -> (i
i0 , s
s0 , o
o0) (i, s, o)
-> Maybe (a, i, s) -> WriterPlus (i, s, o) (Maybe (a, i, s))
forall w a. w -> a -> WriterPlus w a
:+> (a, i, s) -> Maybe (a, i, s)
forall a. a -> Maybe a
Just (a
a , i
i' , s
si)
                                       Right (Re i s o a
x' , s
s' , o
o') -> (i
i0 , s
s0 , o
o0) (i, s, o)
-> WriterPlus (i, s, o) (Maybe (a, i, s))
-> WriterPlus (i, s, o) (Maybe (a, i, s))
forall w a. w -> WriterPlus w a -> WriterPlus w a
:> Re i s o a
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
forall i s o a.
Re i s o a
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
run Re i s o a
x' (i
i' , s
s' , o
o') [i]
is


runP :: RePure i o a -> (i , o) -> [i] -> WriterPlus (i , o) (Maybe (a , i))
runP :: forall i o a.
RePure i o a -> (i, o) -> [i] -> WriterPlus (i, o) (Maybe (a, i))
runP RePure i o a
_ (i
i0, o
o0) []        = (i
i0 , o
o0) (i, o) -> Maybe (a, i) -> WriterPlus (i, o) (Maybe (a, i))
forall w a. w -> a -> WriterPlus w a
:+> Maybe (a, i)
forall a. Maybe a
Nothing
runP RePure i o a
x (i
i0, o
o0) (i
i' : [i]
is) = case RePure i o a -> i -> Either a (RePure i o a, o)
forall i o a. RePure i o a -> i -> Either a (RePure i o a, o)
stepPure RePure i o a
x i
i' of
                                 Left a
a          -> (i
i0 , o
o0) (i, o) -> Maybe (a, i) -> WriterPlus (i, o) (Maybe (a, i))
forall w a. w -> a -> WriterPlus w a
:+> (a, i) -> Maybe (a, i)
forall a. a -> Maybe a
Just (a
a , i
i')
                                 Right (RePure i o a
x' , o
o') -> (i
i0 , o
o0) (i, o)
-> WriterPlus (i, o) (Maybe (a, i))
-> WriterPlus (i, o) (Maybe (a, i))
forall w a. w -> WriterPlus w a -> WriterPlus w a
:> RePure i o a -> (i, o) -> [i] -> WriterPlus (i, o) (Maybe (a, i))
forall i o a.
RePure i o a -> (i, o) -> [i] -> WriterPlus (i, o) (Maybe (a, i))
runP RePure i o a
x' (i
i' , o
o') [i]
is


trace :: Re i s o a -> (i , s , o) -> [i] -> [(i , s , o)]
trace :: forall i s o a. Re i s o a -> (i, s, o) -> [i] -> [(i, s, o)]
trace Re i s o a
d (i, s, o)
iso0 = WriterPlus (i, s, o) (Maybe (a, i, s)) -> [(i, s, o)]
forall w a. WriterPlus w a -> [w]
toList (WriterPlus (i, s, o) (Maybe (a, i, s)) -> [(i, s, o)])
-> ([i] -> WriterPlus (i, s, o) (Maybe (a, i, s)))
-> [i]
-> [(i, s, o)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Re i s o a
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
forall i s o a.
Re i s o a
-> (i, s, o) -> [i] -> WriterPlus (i, s, o) (Maybe (a, i, s))
run Re i s o a
d (i, s, o)
iso0


traceP :: RePure i o a -> (i , o) -> [i] -> [(i , o)]
traceP :: forall i o a. RePure i o a -> (i, o) -> [i] -> [(i, o)]
traceP RePure i o a
d (i, o)
io0 = WriterPlus (i, o) (Maybe (a, i)) -> [(i, o)]
forall w a. WriterPlus w a -> [w]
toList (WriterPlus (i, o) (Maybe (a, i)) -> [(i, o)])
-> ([i] -> WriterPlus (i, o) (Maybe (a, i))) -> [i] -> [(i, o)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RePure i o a -> (i, o) -> [i] -> WriterPlus (i, o) (Maybe (a, i))
forall i o a.
RePure i o a -> (i, o) -> [i] -> WriterPlus (i, o) (Maybe (a, i))
runP RePure i o a
d (i, o)
io0

data WriterPlus w a = w :> WriterPlus w a | w :+> a

instance (Show w , Show a) => Show (WriterPlus w a) where
  show :: WriterPlus w a -> String
show (w
w :> WriterPlus w a
ws) = w -> String
forall a. Show a => a -> String
show w
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WriterPlus w a -> String
forall a. Show a => a -> String
show WriterPlus w a
ws
  show (w
w :+> a
a) = w -> String
forall a. Show a => a -> String
show w
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :+> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a

toList :: WriterPlus w a -> [w]
toList :: forall w a. WriterPlus w a -> [w]
toList (w
w :> WriterPlus w a
ws) = w
w w -> [w] -> [w]
forall a. a -> [a] -> [a]
: WriterPlus w a -> [w]
forall w a. WriterPlus w a -> [w]
toList WriterPlus w a
ws
toList (w
w :+> a
_) = [w
w]