{-# 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)
data UnexpectedEOI = UnexpectedEOI deriving (Int -> UnexpectedEOI -> ShowS
[UnexpectedEOI] -> ShowS
UnexpectedEOI -> String
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
type PureState = ([String], Seq Char)
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)) = forall s a. State s a -> s -> (a, s)
runState (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, forall a. Seq a
empty)
in (Maybe 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
String
x <- forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. [a] -> [a]
tail)
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
crashIfNull :: State PureState ()
crashIfNull :: State PureState ()
crashIfNull = do ([String]
x, Seq Char
y ) <- forall s (m :: * -> *). MonadState s m => m s
get
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
x) forall a b. (a -> b) -> a -> b
$ forall a e. Exception e => e -> a
throw UnexpectedEOI
UnexpectedEOI
getPureChar :: State PureState Char
getPureChar :: State PureState Char
getPureChar = do State PureState ()
crashIfNull
Bool
x <- forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
if Bool
x then do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. [a] -> [a]
tail)
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
else do
Char
r <- forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\ (String
x : [String]
r) -> forall a. [a] -> [a]
tail String
x forall a. a -> [a] -> [a]
: [String]
r))
forall (m :: * -> *) a. Monad m => a -> m a
return Char
r
outputPure :: String -> State PureState ()
outputPure :: String -> State PureState ()
outputPure String
s = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. Seq a -> Seq a -> Seq a
>< forall a. [a] -> Seq a
fromList String
s))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PureState
s -> PureState
s seq :: forall a b. a -> b -> b
`seq` PureState
s)
outputLnPure :: String -> State PureState ()
outputLnPure :: String -> State PureState ()
outputLnPure String
s = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ (forall a. Seq a -> a -> Seq a
|> Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Seq a -> Seq a -> Seq a
>< forall a. [a] -> Seq a
fromList String
s))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\PureState
s -> PureState
s seq :: 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 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 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 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> State PureState v
w
newtype Pure a = Pure ((Output :+: OutputLn :+: Line :+: Character) a)
deriving ( (:<:) Output
, (:<:) OutputLn
, (:<:) Line
, (:<:) Character
, 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
<$ :: forall a b. a -> Pure b -> Pure a
$c<$ :: forall a b. a -> Pure b -> Pure a
fmap :: forall a b. (a -> b) -> Pure a -> Pure b
$cfmap :: forall a b. (a -> b) -> Pure a -> Pure b
Functor
, Run (State PureState)
)