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 (Show, Typeable)
instance Exception UnexpectedEOI
type PureState = ([String], Seq Char)
runPure :: Wizard Pure a -> String -> (Maybe a, String)
runPure wz input = let (a,(_,o)) = runState (run wz) (lines input, empty)
in (a, toList o)
getPureLine :: State PureState String
getPureLine = do crashIfNull
x <- head . fst <$> get
modify (first tail)
return x
crashIfNull :: State PureState ()
crashIfNull = do (x, y ) <- get
when (null x) $ throw UnexpectedEOI
getPureChar :: State PureState Char
getPureChar = do crashIfNull
x <- null . head . fst <$> get
if x then do
modify (first tail)
return '\n'
else do
r <- head . head . fst <$> get
modify (first (\ (x : r) -> tail x : r))
return r
outputPure :: String -> State PureState ()
outputPure s = modify (second (>< fromList s))
>> modify (\s -> s `seq` s)
outputLnPure :: String -> State PureState ()
outputLnPure s = modify (second $ (|> '\n') . (>< fromList s))
>> modify (\s -> s `seq` s)
instance Run (State PureState) Output where runAlgebra (Output s w) = outputPure s >> w
instance Run (State PureState) OutputLn where runAlgebra (OutputLn s w) = outputLnPure s >> w
instance Run (State PureState) Line where runAlgebra (Line s w) = getPureLine >>= w
instance Run (State PureState) Character where runAlgebra (Character s w) = getPureChar >>= w
newtype Pure a = Pure ((Output :+: OutputLn :+: Line :+: Character) a)
deriving ( (:<:) Output
, (:<:) OutputLn
, (:<:) Line
, (:<:) Character
, Functor
, Run (State PureState)
)