    {-# 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
    $cshowsPrec :: Int -> UnexpectedEOI -> ShowS
    showsPrec :: Int -> UnexpectedEOI -> ShowS
    $cshow :: UnexpectedEOI -> String
    show :: UnexpectedEOI -> String
    $cshowList :: [UnexpectedEOI] -> ShowS
    showList :: [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 :: forall a. Wizard Pure a -> String -> (Maybe a, String)
    runPure Wizard Pure a
    wz String
    input = let (Maybe a
    a,([String]
    _,Seq Char
    o)) = State PureState (Maybe a) -> PureState -> (Maybe a, PureState)
    forall s a. State s a -> s -> (a, s)
    runState (Wizard Pure a -> State PureState (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 a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Seq Char
    o)

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

    crashIfNull :: State PureState ()
    crashIfNull :: State PureState ()
    crashIfNull = do (x, y ) <- StateT PureState Identity PureState
    forall s (m :: * -> *). MonadState s m => m s
    get
                     when (null x) $ throw UnexpectedEOI

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

    outputPure :: String -> State PureState ()
    outputPure :: String -> State PureState ()
    outputPure String
    s = (PureState -> PureState) -> State PureState ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Seq Char -> Seq Char) -> PureState -> PureState
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    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 PureState () -> State PureState () -> State PureState ()
    forall a b.
    StateT PureState Identity a
    -> StateT PureState Identity b -> StateT PureState Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (PureState -> PureState) -> State PureState ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\PureState
    s -> PureState
    s PureState -> PureState -> PureState
    forall a b. a -> b -> b
    `seq` PureState
    s)

    outputLnPure :: String -> State PureState ()
    outputLnPure :: String -> State PureState ()
    outputLnPure String
    s = (PureState -> PureState) -> State PureState ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Seq Char -> Seq Char) -> PureState -> PureState
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((Seq Char -> Seq Char) -> PureState -> PureState)
    -> (Seq Char -> Seq Char) -> PureState -> PureState
    forall a b. (a -> b) -> a -> b
    $ (Seq Char -> Char -> Seq Char
    forall a. Seq a -> a -> Seq a
    |> Char
    '\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 PureState () -> State PureState () -> State PureState ()
    forall a b.
    StateT PureState Identity a
    -> StateT PureState Identity b -> StateT PureState Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (PureState -> PureState) -> State PureState ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\PureState
    s -> PureState
    s PureState -> PureState -> PureState
    forall a b. a -> b -> b
    `seq` PureState
    s)

    instance Run (State PureState) Output    where runAlgebra :: forall v. Output (State PureState v) -> State PureState v
    runAlgebra (Output String
    s State PureState v
    w)        = String -> State PureState ()
    outputPure String
    s   State PureState () -> State PureState v -> State PureState v
    forall a b.
    StateT PureState Identity a
    -> StateT PureState Identity b -> StateT PureState Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> State PureState v
    w
    instance Run (State PureState) OutputLn  where runAlgebra :: forall v. OutputLn (State PureState v) -> State PureState v
    runAlgebra (OutputLn String
    s State PureState v
    w)      = String -> State PureState ()
    outputLnPure String
    s State PureState () -> State PureState v -> State PureState v
    forall a b.
    StateT PureState Identity a
    -> StateT PureState Identity b -> StateT PureState Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> State PureState v
    w
    instance Run (State PureState) Line      where runAlgebra :: forall v. Line (State PureState v) -> State PureState v
    runAlgebra (Line String
    s String -> State PureState v
    w)          = State PureState String
    getPureLine    State PureState String
    -> (String -> State PureState v) -> State PureState v
    forall a b.
    StateT PureState Identity a
    -> (a -> StateT PureState Identity b)
    -> StateT PureState Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> State PureState v
    w
    instance Run (State PureState) Character where runAlgebra :: forall v. Character (State PureState v) -> State PureState v
    runAlgebra (Character String
    s Char -> State PureState v
    w)     = State PureState Char
    getPureChar    State PureState Char
    -> (Char -> State PureState v) -> State PureState v
    forall a b.
    StateT PureState Identity a
    -> (a -> StateT PureState Identity b)
    -> StateT PureState Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Char -> State PureState 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
                            , (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
    $cfmap :: forall a b. (a -> b) -> Pure a -> Pure b
    fmap :: forall a b. (a -> b) -> Pure a -> Pure b
    $c<$ :: forall a b. a -> Pure b -> Pure a
    <$ :: forall a b. a -> Pure b -> Pure a
    Functor
                            , Run (State PureState)
                            )