    {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, FlexibleInstances, TypeOperators, DoAndIfThenElse, GeneralizedNewtypeDeriving, Trustworthy #-}
    module System.Console.Wizard.Pure
            ( Pure
            , UnexpectedEOI (..)
            , runPure
            , PureState (..)
            ) where

    import System.Console.Wizard
    import System.Console.Wizard.Internal
    import Control.Monad.Trans
    import Control.Monad.State.Lazy
    import Control.Monad.Trans.Maybe
    import Control.Applicative((<$>))
    import Data.Typeable
    import Data.Sequence(Seq, (|>), (><), fromList, empty)
    import Control.Monad
    import Control.Exception
    import Control.Arrow
    import Data.Foldable(toList)

    -- | Thrown if the wizard ever unexpectedly runs out of input.
    data UnexpectedEOI = UnexpectedEOI deriving (Int -> UnexpectedEOI -> ShowS
    [UnexpectedEOI] -> ShowS
    UnexpectedEOI -> String
    (Int -> UnexpectedEOI -> ShowS)
    -> (UnexpectedEOI -> String)
    -> ([UnexpectedEOI] -> ShowS)
    -> Show UnexpectedEOI
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [UnexpectedEOI] -> ShowS
    $cshowList :: [UnexpectedEOI] -> ShowS
    show :: UnexpectedEOI -> String
    $cshow :: UnexpectedEOI -> String
    showsPrec :: Int -> UnexpectedEOI -> ShowS
    $cshowsPrec :: Int -> UnexpectedEOI -> ShowS
    Show, Typeable)
    instance Exception UnexpectedEOI

    -- | The pure backend is actually just a simple state monad, with the following state.
    type PureState = ([String], Seq Char)

    -- | Run a wizard in the Pure backend
    runPure :: Wizard Pure a -> String -> (Maybe a, String)
    runPure :: Wizard Pure a -> String -> (Maybe a, String)
    runPure wz :: Wizard Pure a
    wz input :: String
    input = let (a :: Maybe a
    a,(_,o :: Seq Char
    o)) = State ([String], Seq Char) (Maybe a)
    -> ([String], Seq Char) -> (Maybe a, ([String], Seq Char))
    forall s a. State s a -> s -> (a, s)
    runState (Wizard Pure a -> State ([String], Seq Char) (Maybe a)
    forall (f :: * -> *) (b :: * -> *) a.
    (Functor f, Monad b, Run b f) =>
    Wizard f a -> b (Maybe a)
    run Wizard Pure a
    wz) (String -> [String]
    lines String
    input, Seq Char
    forall a. Seq a
    empty)
                           in (Maybe a
    a, Seq Char -> String
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Seq Char
    o)

    getPureLine :: State PureState String
    getPureLine :: State ([String], Seq Char) String
    getPureLine = do State ([String], Seq Char) ()
    crashIfNull
                     String
    x <- [String] -> String
    forall a. [a] -> a
    head ([String] -> String)
    -> (([String], Seq Char) -> [String])
    -> ([String], Seq Char)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String], Seq Char) -> [String]
    forall a b. (a, b) -> a
    fst (([String], Seq Char) -> String)
    -> StateT ([String], Seq Char) Identity ([String], Seq Char)
    -> State ([String], Seq Char) String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT ([String], Seq Char) Identity ([String], Seq Char)
    forall s (m :: * -> *). MonadState s m => m s
    get
                     (([String], Seq Char) -> ([String], Seq Char))
    -> State ([String], Seq Char) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (([String] -> [String])
    -> ([String], Seq Char) -> ([String], Seq Char)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first [String] -> [String]
    forall a. [a] -> [a]
    tail)
                     String -> State ([String], Seq Char) String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    x

    crashIfNull :: State PureState ()
    crashIfNull :: State ([String], Seq Char) ()
    crashIfNull = do (x :: [String]
    x, y :: Seq Char
    y ) <- StateT ([String], Seq Char) Identity ([String], Seq Char)
    forall s (m :: * -> *). MonadState s m => m s
    get
                     Bool
    -> State ([String], Seq Char) () -> State ([String], Seq Char) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    x) (State ([String], Seq Char) () -> State ([String], Seq Char) ())
    -> State ([String], Seq Char) () -> State ([String], Seq Char) ()
    forall a b. (a -> b) -> a -> b
    $ UnexpectedEOI -> State ([String], Seq Char) ()
    forall a e. Exception e => e -> a
    throw UnexpectedEOI
    UnexpectedEOI

    getPureChar :: State PureState Char
    getPureChar :: State ([String], Seq Char) Char
    getPureChar = do State ([String], Seq Char) ()
    crashIfNull
                     Bool
    x <- String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (String -> Bool)
    -> (([String], Seq Char) -> String) -> ([String], Seq Char) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall a. [a] -> a
    head ([String] -> String)
    -> (([String], Seq Char) -> [String])
    -> ([String], Seq Char)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String], Seq Char) -> [String]
    forall a b. (a, b) -> a
    fst (([String], Seq Char) -> Bool)
    -> StateT ([String], Seq Char) Identity ([String], Seq Char)
    -> StateT ([String], Seq Char) Identity Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT ([String], Seq Char) Identity ([String], Seq Char)
    forall s (m :: * -> *). MonadState s m => m s
    get
                     if Bool
    x then do
                        (([String], Seq Char) -> ([String], Seq Char))
    -> State ([String], Seq Char) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (([String] -> [String])
    -> ([String], Seq Char) -> ([String], Seq Char)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first [String] -> [String]
    forall a. [a] -> [a]
    tail)
                        Char -> State ([String], Seq Char) Char
    forall (m :: * -> *) a. Monad m => a -> m a
    return '\n'
                     else do
                        Char
    r <- String -> Char
    forall a. [a] -> a
    head (String -> Char)
    -> (([String], Seq Char) -> String) -> ([String], Seq Char) -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall a. [a] -> a
    head ([String] -> String)
    -> (([String], Seq Char) -> [String])
    -> ([String], Seq Char)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String], Seq Char) -> [String]
    forall a b. (a, b) -> a
    fst (([String], Seq Char) -> Char)
    -> StateT ([String], Seq Char) Identity ([String], Seq Char)
    -> State ([String], Seq Char) Char
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT ([String], Seq Char) Identity ([String], Seq Char)
    forall s (m :: * -> *). MonadState s m => m s
    get
                        (([String], Seq Char) -> ([String], Seq Char))
    -> State ([String], Seq Char) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (([String] -> [String])
    -> ([String], Seq Char) -> ([String], Seq Char)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (\ (x :: String
    x : r :: [String]
    r) -> ShowS
    forall a. [a] -> [a]
    tail String
    x String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    r))
                        Char -> State ([String], Seq Char) Char
    forall (m :: * -> *) a. Monad m => a -> m a
    return Char
    r

    outputPure :: String -> State PureState ()
    outputPure :: String -> State ([String], Seq Char) ()
    outputPure s :: String
    s = (([String], Seq Char) -> ([String], Seq Char))
    -> State ([String], Seq Char) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Seq Char -> Seq Char)
    -> ([String], Seq Char) -> ([String], Seq Char)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Seq Char -> Seq Char -> Seq Char
    forall a. Seq a -> Seq a -> Seq a
    >< String -> Seq Char
    forall a. [a] -> Seq a
    fromList String
    s))
                State ([String], Seq Char) ()
    -> State ([String], Seq Char) () -> State ([String], Seq Char) ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (([String], Seq Char) -> ([String], Seq Char))
    -> State ([String], Seq Char) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\s :: ([String], Seq Char)
    s -> ([String], Seq Char)
    s ([String], Seq Char)
    -> ([String], Seq Char) -> ([String], Seq Char)
    forall a b. a -> b -> b
    `seq` ([String], Seq Char)
    s)

    outputLnPure :: String -> State PureState ()
    outputLnPure :: String -> State ([String], Seq Char) ()
    outputLnPure s :: String
    s = (([String], Seq Char) -> ([String], Seq Char))
    -> State ([String], Seq Char) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Seq Char -> Seq Char)
    -> ([String], Seq Char) -> ([String], Seq Char)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((Seq Char -> Seq Char)
     -> ([String], Seq Char) -> ([String], Seq Char))
    -> (Seq Char -> Seq Char)
    -> ([String], Seq Char)
    -> ([String], Seq Char)
    forall a b. (a -> b) -> a -> b
    $ (Seq Char -> Char -> Seq Char
    forall a. Seq a -> a -> Seq a
    |> '\n') (Seq Char -> Seq Char)
    -> (Seq Char -> Seq Char) -> Seq Char -> Seq Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Seq Char -> Seq Char -> Seq Char
    forall a. Seq a -> Seq a -> Seq a
    >< String -> Seq Char
    forall a. [a] -> Seq a
    fromList String
    s))
                  State ([String], Seq Char) ()
    -> State ([String], Seq Char) () -> State ([String], Seq Char) ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (([String], Seq Char) -> ([String], Seq Char))
    -> State ([String], Seq Char) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\s :: ([String], Seq Char)
    s -> ([String], Seq Char)
    s ([String], Seq Char)
    -> ([String], Seq Char) -> ([String], Seq Char)
    forall a b. a -> b -> b
    `seq` ([String], Seq Char)
    s)

    instance Run (State PureState) Output    where runAlgebra :: Output (State ([String], Seq Char) v)
    -> State ([String], Seq Char) v
    runAlgebra (Output s :: String
    s w :: State ([String], Seq Char) v
    w)        = String -> State ([String], Seq Char) ()
    outputPure String
    s   State ([String], Seq Char) ()
    -> State ([String], Seq Char) v -> State ([String], Seq Char) v
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> State ([String], Seq Char) v
    w
    instance Run (State PureState) OutputLn  where runAlgebra :: OutputLn (State ([String], Seq Char) v)
    -> State ([String], Seq Char) v
    runAlgebra (OutputLn s :: String
    s w :: State ([String], Seq Char) v
    w)      = String -> State ([String], Seq Char) ()
    outputLnPure String
    s State ([String], Seq Char) ()
    -> State ([String], Seq Char) v -> State ([String], Seq Char) v
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> State ([String], Seq Char) v
    w
    instance Run (State PureState) Line      where runAlgebra :: Line (State ([String], Seq Char) v) -> State ([String], Seq Char) v
    runAlgebra (Line s :: String
    s w :: String -> State ([String], Seq Char) v
    w)          = State ([String], Seq Char) String
    getPureLine    State ([String], Seq Char) String
    -> (String -> State ([String], Seq Char) v)
    -> State ([String], Seq Char) v
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> State ([String], Seq Char) v
    w
    instance Run (State PureState) Character where runAlgebra :: Character (State ([String], Seq Char) v)
    -> State ([String], Seq Char) v
    runAlgebra (Character s :: String
    s w :: Char -> State ([String], Seq Char) v
    w)     = State ([String], Seq Char) Char
    getPureChar    State ([String], Seq Char) Char
    -> (Char -> State ([String], Seq Char) v)
    -> State ([String], Seq Char) v
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Char -> State ([String], Seq Char) v
    w

    -- | The 'Pure' backend supports only simple input and output.
    --   Support for 'Password' and 'LinePrewritten' features can be added with
    --   a shim from "System.Console.Wizard.Shim".
    newtype Pure a = Pure ((Output :+: OutputLn :+: Line :+: Character) a)
                   deriving ( (:<:) Output
                            , (:<:) OutputLn
                            , (:<:) Line
                            , (:<:) Character
                            , a -> Pure b -> Pure a
    (a -> b) -> Pure a -> Pure b
    (forall a b. (a -> b) -> Pure a -> Pure b)
    -> (forall a b. a -> Pure b -> Pure a) -> Functor Pure
    forall a b. a -> Pure b -> Pure a
    forall a b. (a -> b) -> Pure a -> Pure b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: a -> Pure b -> Pure a
    $c<$ :: forall a b. a -> Pure b -> Pure a
    fmap :: (a -> b) -> Pure a -> Pure b
    $cfmap :: forall a b. (a -> b) -> Pure a -> Pure b
    Functor
                            , Run (State PureState)
                            )