module Rattletrap.Get where

import qualified Control.Applicative as Applicative

newtype Get s m a = Get (s -> m (Either String (s, a)))

instance Functor m => Functor (Get s m) where
  fmap :: (a -> b) -> Get s m a -> Get s m b
fmap a -> b
f Get s m a
g = (s -> m (Either String (s, b))) -> Get s m b
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, b))) -> Get s m b)
-> (s -> m (Either String (s, b))) -> Get s m b
forall a b. (a -> b) -> a -> b
$ (Either String (s, a) -> Either String (s, b))
-> m (Either String (s, a)) -> m (Either String (s, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((s, a) -> (s, b)) -> Either String (s, a) -> Either String (s, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (s, a) -> (s, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (m (Either String (s, a)) -> m (Either String (s, b)))
-> (s -> m (Either String (s, a))) -> s -> m (Either String (s, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get s m a -> s -> m (Either String (s, a))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
run Get s m a
g

instance Monad m => Applicative (Get s m) where
  pure :: a -> Get s m a
pure a
x = (s -> m (Either String (s, a))) -> Get s m a
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, a))) -> Get s m a)
-> (s -> m (Either String (s, a))) -> Get s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> Either String (s, a) -> m (Either String (s, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (s, a) -> m (Either String (s, a)))
-> Either String (s, a) -> m (Either String (s, a))
forall a b. (a -> b) -> a -> b
$ (s, a) -> Either String (s, a)
forall a b. b -> Either a b
Right (s
s, a
x)

  Get s m (a -> b)
gf <*> :: Get s m (a -> b) -> Get s m a -> Get s m b
<*> Get s m a
gx = (s -> m (Either String (s, b))) -> Get s m b
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, b))) -> Get s m b)
-> (s -> m (Either String (s, b))) -> Get s m b
forall a b. (a -> b) -> a -> b
$ \s
s1 -> do
    Either String (s, a -> b)
r <- Get s m (a -> b) -> s -> m (Either String (s, a -> b))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
run Get s m (a -> b)
gf s
s1
    case Either String (s, a -> b)
r of
      Left String
e -> Either String (s, b) -> m (Either String (s, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (s, b) -> m (Either String (s, b)))
-> Either String (s, b) -> m (Either String (s, b))
forall a b. (a -> b) -> a -> b
$ String -> Either String (s, b)
forall a b. a -> Either a b
Left String
e
      Right (s
s2, a -> b
f) -> Get s m b -> s -> m (Either String (s, b))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
run ((a -> b) -> Get s m a -> Get s m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Get s m a
gx) s
s2

instance Monad m => Monad (Get s m) where
  Get s m a
g >>= :: Get s m a -> (a -> Get s m b) -> Get s m b
>>= a -> Get s m b
f = (s -> m (Either String (s, b))) -> Get s m b
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, b))) -> Get s m b)
-> (s -> m (Either String (s, b))) -> Get s m b
forall a b. (a -> b) -> a -> b
$ \s
s1 -> do
    Either String (s, a)
r <- Get s m a -> s -> m (Either String (s, a))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
run Get s m a
g s
s1
    case Either String (s, a)
r of
      Left String
e -> Either String (s, b) -> m (Either String (s, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (s, b) -> m (Either String (s, b)))
-> Either String (s, b) -> m (Either String (s, b))
forall a b. (a -> b) -> a -> b
$ String -> Either String (s, b)
forall a b. a -> Either a b
Left String
e
      Right (s
s2, a
x) -> Get s m b -> s -> m (Either String (s, b))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
run (a -> Get s m b
f a
x) s
s2

instance Monad m => MonadFail (Get s m) where
  fail :: String -> Get s m a
fail = (s -> m (Either String (s, a))) -> Get s m a
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, a))) -> Get s m a)
-> (String -> s -> m (Either String (s, a))) -> String -> Get s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either String (s, a)) -> s -> m (Either String (s, a))
forall a b. a -> b -> a
const (m (Either String (s, a)) -> s -> m (Either String (s, a)))
-> (String -> m (Either String (s, a)))
-> String
-> s
-> m (Either String (s, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String (s, a) -> m (Either String (s, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (s, a) -> m (Either String (s, a)))
-> (String -> Either String (s, a))
-> String
-> m (Either String (s, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (s, a)
forall a b. a -> Either a b
Left

instance Monad m => Applicative.Alternative (Get s m) where
  empty :: Get s m a
empty = String -> Get s m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"

  Get s m a
gx <|> :: Get s m a -> Get s m a -> Get s m a
<|> Get s m a
gy = (s -> m (Either String (s, a))) -> Get s m a
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, a))) -> Get s m a)
-> (s -> m (Either String (s, a))) -> Get s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> do
    Either String (s, a)
r <- Get s m a -> s -> m (Either String (s, a))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
run Get s m a
gx s
s
    case Either String (s, a)
r of
      Left String
_ -> Get s m a -> s -> m (Either String (s, a))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
run Get s m a
gy s
s
      Right (s, a)
x -> Either String (s, a) -> m (Either String (s, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (s, a) -> m (Either String (s, a)))
-> Either String (s, a) -> m (Either String (s, a))
forall a b. (a -> b) -> a -> b
$ (s, a) -> Either String (s, a)
forall a b. b -> Either a b
Right (s, a)
x

run :: Get s m a -> s -> m (Either String (s, a))
run :: Get s m a -> s -> m (Either String (s, a))
run (Get s -> m (Either String (s, a))
f) = s -> m (Either String (s, a))
f

get :: Applicative m => Get s m s
get :: Get s m s
get = (s -> m (Either String (s, s))) -> Get s m s
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, s))) -> Get s m s)
-> (s -> m (Either String (s, s))) -> Get s m s
forall a b. (a -> b) -> a -> b
$ \s
s -> Either String (s, s) -> m (Either String (s, s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (s, s) -> m (Either String (s, s)))
-> Either String (s, s) -> m (Either String (s, s))
forall a b. (a -> b) -> a -> b
$ (s, s) -> Either String (s, s)
forall a b. b -> Either a b
Right (s
s, s
s)

put :: Applicative m => s -> Get s m ()
put :: s -> Get s m ()
put s
s = (s -> m (Either String (s, ()))) -> Get s m ()
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, ()))) -> Get s m ())
-> (s -> m (Either String (s, ()))) -> Get s m ()
forall a b. (a -> b) -> a -> b
$ \s
_ -> Either String (s, ()) -> m (Either String (s, ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (s, ()) -> m (Either String (s, ())))
-> Either String (s, ()) -> m (Either String (s, ()))
forall a b. (a -> b) -> a -> b
$ (s, ()) -> Either String (s, ())
forall a b. b -> Either a b
Right (s
s, ())

lift :: Functor m => m a -> Get s m a
lift :: m a -> Get s m a
lift m a
m = (s -> m (Either String (s, a))) -> Get s m a
forall s (m :: * -> *) a.
(s -> m (Either String (s, a))) -> Get s m a
Get ((s -> m (Either String (s, a))) -> Get s m a)
-> (s -> m (Either String (s, a))) -> Get s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> (a -> Either String (s, a)) -> m a -> m (Either String (s, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (s, a) -> Either String (s, a)
forall a b. b -> Either a b
Right (s
s, a
x)) m a
m