module MyIO where

import MyState
import MyStream

newtype MyIO s a = MyIO (WithIO s -> (a, WithIO s))

unMyIO :: MyIO s a -> WithIO s -> (a, WithIO s)
unMyIO (MyIO m) = m

instance Functor (MyIO s) where
  fmap f x = x >>= \ a -> return (f a)

instance Applicative (MyIO s) where
  pure a = MyIO (\ s -> (a, s))
  f <*> x = f >>= \ g -> x >>= \ a -> return (g a)

instance Monad (MyIO s) where -- 基本的には ST と同じ
  (MyIO m) >>= k  = MyIO (\ w -> let (a,w1) = m w in unMyIO (k a) w1)

extendIO :: Pos s t -> MyIO t a -> MyIO s a
extendIO p (MyIO m) = MyIO (\ (s, i, o) ->
                      let (t, rest)           = p s
                          (a, (t1, i1, o1))   = m (t, i, o)
                        in (a, (rest t1, i1, o1)))

shrinkIO :: (s -> t) -> (t -> s) -> MyIO s a -> MyIO t a
shrinkIO extract rest (MyIO m) = MyIO (\ (t, i, o) ->
                          let (a, (s, i1, o1)) = m (rest t, i, o)
                            in (a, (extract s, i1, o1)))

instance MyState MyIO where
  set p v = MyIO (\ (s,i,o) -> (v, (snd (p s) v,i,o)))
  get p   = MyIO (\ (s,i,o) -> (fst (p s), (s,i,o)))
  extend = extendIO
  shrink = shrinkIO

instance MyStream (MyIO s) where
  readChar    = MyIO (\ (s,c:cs,o) -> (c,(s,cs,o)))
  eof         = MyIO (\ (s,i,o) -> (null i,(s,i,o)))
  writeStr v  = MyIO (\ (s,i,o) -> ((),(s,i,o ++ v)))

fst3 (x,_,_) = x
snd3 (_,y,_) = y
thd3 (_,_,z) = z

atoi :: String -> Integer
atoi = read

atof :: String -> Double
atof = read

evalMyIO e s = let (_,(_,_,o)) = unMyIO e (s,"","") in o