module Rattletrap.Get where

import qualified Control.Applicative as Applicative
import qualified Control.Exception as Exception
import qualified Data.Bifunctor as Bifunctor
import qualified Rattletrap.Exception.Empty as Empty
import qualified Rattletrap.Exception.Fail as Fail

newtype Get s m a = Get (s -> m (Either ([String], Exception.SomeException) (s, a)))

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

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

  Get s m (a -> b)
gf <*> :: forall a b. Get s m (a -> b) -> Get s m a -> Get s m b
<*> Get s m a
gx = forall s (m :: * -> *) a.
(s -> m (Either ([String], SomeException) (s, a))) -> Get s m a
Get forall a b. (a -> b) -> a -> b
$ \s
s1 -> do
    Either ([String], SomeException) (s, a -> b)
r <- forall s (m :: * -> *) a.
Get s m a -> s -> m (Either ([String], SomeException) (s, a))
run Get s m (a -> b)
gf s
s1
    case Either ([String], SomeException) (s, a -> b)
r of
      Left ([String], SomeException)
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([String], SomeException)
e
      Right (s
s2, a -> b
f) -> forall s (m :: * -> *) a.
Get s m a -> s -> m (Either ([String], SomeException) (s, a))
run (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 >>= :: forall a b. Get s m a -> (a -> Get s m b) -> Get s m b
>>= a -> Get s m b
f = forall s (m :: * -> *) a.
(s -> m (Either ([String], SomeException) (s, a))) -> Get s m a
Get forall a b. (a -> b) -> a -> b
$ \s
s1 -> do
    Either ([String], SomeException) (s, a)
r <- forall s (m :: * -> *) a.
Get s m a -> s -> m (Either ([String], SomeException) (s, a))
run Get s m a
g s
s1
    case Either ([String], SomeException) (s, a)
r of
      Left ([String], SomeException)
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([String], SomeException)
e
      Right (s
s2, a
x) -> forall s (m :: * -> *) a.
Get s m a -> s -> m (Either ([String], SomeException) (s, a))
run (a -> Get s m b
f a
x) s
s2

instance (Monad m) => MonadFail (Get s m) where
  fail :: forall a. String -> Get s m a
fail = forall e (m :: * -> *) s a.
(Exception e, Applicative m) =>
e -> Get s m a
throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Fail
Fail.Fail

instance (Monad m) => Applicative.Alternative (Get s m) where
  empty :: forall a. Get s m a
empty = forall e (m :: * -> *) s a.
(Exception e, Applicative m) =>
e -> Get s m a
throw Empty
Empty.Empty

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

run :: Get s m a -> s -> m (Either ([String], Exception.SomeException) (s, a))
run :: forall s (m :: * -> *) a.
Get s m a -> s -> m (Either ([String], SomeException) (s, a))
run (Get s -> m (Either ([String], SomeException) (s, a))
f) = s -> m (Either ([String], SomeException) (s, a))
f

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

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

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

throw :: (Exception.Exception e, Applicative m) => e -> Get s m a
throw :: forall e (m :: * -> *) s a.
(Exception e, Applicative m) =>
e -> Get s m a
throw = forall s (m :: * -> *) a.
(s -> m (Either ([String], SomeException) (s, a))) -> Get s m a
Get forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
Exception.toException

embed :: (Monad m) => Get s m a -> s -> Get t m a
embed :: forall (m :: * -> *) s a t. Monad m => Get s m a -> s -> Get t m a
embed Get s m a
g s
s = do
  Either ([String], SomeException) (s, a)
r <- forall (m :: * -> *) a s. Functor m => m a -> Get s m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a.
Get s m a -> s -> m (Either ([String], SomeException) (s, a))
run Get s m a
g s
s
  case Either ([String], SomeException) (s, a)
r of
    Left ([String]
ls, SomeException
e) -> forall (m :: * -> *) s a.
Functor m =>
[String] -> Get s m a -> Get s m a
labels [String]
ls forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) s a.
(Exception e, Applicative m) =>
e -> Get s m a
throw SomeException
e
    Right (s
_, a
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

labels :: (Functor m) => [String] -> Get s m a -> Get s m a
labels :: forall (m :: * -> *) s a.
Functor m =>
[String] -> Get s m a -> Get s m a
labels [String]
ls Get s m a
g = forall s (m :: * -> *) a.
(s -> m (Either ([String], SomeException) (s, a))) -> Get s m a
Get forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first ([String]
ls forall a. Semigroup a => a -> a -> a
<>)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
Get s m a -> s -> m (Either ([String], SomeException) (s, a))
run Get s m a
g

label :: (Functor m) => String -> Get s m a -> Get s m a
label :: forall (m :: * -> *) s a.
Functor m =>
String -> Get s m a -> Get s m a
label = forall (m :: * -> *) s a.
Functor m =>
[String] -> Get s m a -> Get s m a
labels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure