{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy #-}
module System.Console.Wizard.Haskeline 
        ( UnexpectedEOF (..)
        , Haskeline
        , haskeline
        , withSettings
        , WithSettings(..)
        ) where
import System.Console.Wizard
import System.Console.Wizard.Internal
import System.Console.Haskeline    
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Exception
import Data.Typeable


-- | The Haskeline back-end will throw this exception if EOF is encountered
--   when it is not expected. Specifically, when actions such as 'getInputLine' return 'Nothing'.
data UnexpectedEOF = UnexpectedEOF deriving (Int -> UnexpectedEOF -> ShowS
[UnexpectedEOF] -> ShowS
UnexpectedEOF -> String
(Int -> UnexpectedEOF -> ShowS)
-> (UnexpectedEOF -> String)
-> ([UnexpectedEOF] -> ShowS)
-> Show UnexpectedEOF
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnexpectedEOF -> ShowS
showsPrec :: Int -> UnexpectedEOF -> ShowS
$cshow :: UnexpectedEOF -> String
show :: UnexpectedEOF -> String
$cshowList :: [UnexpectedEOF] -> ShowS
showList :: [UnexpectedEOF] -> ShowS
Show, Typeable)
instance Exception UnexpectedEOF

-- | Haskeline supports all the following features completely. 
newtype Haskeline a = Haskeline (( Output 
                               :+: OutputLn 
                               :+: Line 
                               :+: Character 
                               :+: LinePrewritten 
                               :+: Password 
                               :+: ArbitraryIO 
                               :+: WithSettings) a)
                  deriving ( (:<:) Output
                           , (:<:) OutputLn
                           , (:<:) Line
                           , (:<:) Character
                           , (:<:) LinePrewritten
                           , (:<:) Password
                           , (:<:) ArbitraryIO
                           , (:<:) WithSettings
                           , (forall a b. (a -> b) -> Haskeline a -> Haskeline b)
-> (forall a b. a -> Haskeline b -> Haskeline a)
-> Functor Haskeline
forall a b. a -> Haskeline b -> Haskeline a
forall a b. (a -> b) -> Haskeline a -> Haskeline 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) -> Haskeline a -> Haskeline b
fmap :: forall a b. (a -> b) -> Haskeline a -> Haskeline b
$c<$ :: forall a b. a -> Haskeline b -> Haskeline a
<$ :: forall a b. a -> Haskeline b -> Haskeline a
Functor
                           , Run (InputT IO)
                           )                           

-- | Modifies a wizard so that it will run with different Haskeline 'Settings' to the top level input monad.
withSettings :: (WithSettings :<: b) => Settings IO -> Wizard b a -> Wizard b a
withSettings :: forall (b :: * -> *) a.
(WithSettings :<: b) =>
Settings IO -> Wizard b a -> Wizard b a
withSettings Settings IO
sets (Wizard (MaybeT Free b (Maybe a)
v)) = MaybeT (Free b) a -> Wizard b a
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) a -> Wizard b a)
-> MaybeT (Free b) a -> Wizard b a
forall a b. (a -> b) -> a -> b
$ Free b (Maybe a) -> MaybeT (Free b) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Free b (Maybe a) -> MaybeT (Free b) a)
-> Free b (Maybe a) -> MaybeT (Free b) a
forall a b. (a -> b) -> a -> b
$ WithSettings (Free b (Maybe a)) -> Free b (Maybe a)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (Settings IO -> Free b (Maybe a) -> WithSettings (Free b (Maybe a))
forall w. Settings IO -> w -> WithSettings w
WithSettings Settings IO
sets Free b (Maybe a)
v)

data WithSettings w = WithSettings (Settings IO) w deriving ((forall a b. (a -> b) -> WithSettings a -> WithSettings b)
-> (forall a b. a -> WithSettings b -> WithSettings a)
-> Functor WithSettings
forall a b. a -> WithSettings b -> WithSettings a
forall a b. (a -> b) -> WithSettings a -> WithSettings 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) -> WithSettings a -> WithSettings b
fmap :: forall a b. (a -> b) -> WithSettings a -> WithSettings b
$c<$ :: forall a b. a -> WithSettings b -> WithSettings a
<$ :: forall a b. a -> WithSettings b -> WithSettings a
Functor) 

instance Run (InputT IO) Output          where runAlgebra :: forall v. Output (InputT IO v) -> InputT IO v
runAlgebra (Output String
s InputT IO v
w)               = String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
outputStr String
s                       InputT IO () -> InputT IO v -> InputT IO v
forall a b. InputT IO a -> InputT IO b -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InputT IO v
w
instance Run (InputT IO) OutputLn        where runAlgebra :: forall v. OutputLn (InputT IO v) -> InputT IO v
runAlgebra (OutputLn String
s InputT IO v
w)             = String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
outputStrLn String
s                     InputT IO () -> InputT IO v -> InputT IO v
forall a b. InputT IO a -> InputT IO b -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InputT IO v
w
instance Run (InputT IO) Line            where runAlgebra :: forall v. Line (InputT IO v) -> InputT IO v
runAlgebra (Line String
s String -> InputT IO v
w)                 = String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
getInputLine String
s                    InputT IO (Maybe String)
-> (Maybe String -> InputT IO v) -> InputT IO v
forall a b. InputT IO a -> (a -> InputT IO b) -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> InputT IO v) -> Maybe String -> InputT IO v
forall {a} {b}. (a -> b) -> Maybe a -> b
mEof String -> InputT IO v
w
instance Run (InputT IO) Character       where runAlgebra :: forall v. Character (InputT IO v) -> InputT IO v
runAlgebra (Character String
s Char -> InputT IO v
w)            = String -> InputT IO (Maybe Char)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe Char)
getInputChar String
s                    InputT IO (Maybe Char)
-> (Maybe Char -> InputT IO v) -> InputT IO v
forall a b. InputT IO a -> (a -> InputT IO b) -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Char -> InputT IO v) -> Maybe Char -> InputT IO v
forall {a} {b}. (a -> b) -> Maybe a -> b
mEof Char -> InputT IO v
w
instance Run (InputT IO) LinePrewritten  where runAlgebra :: forall v. LinePrewritten (InputT IO v) -> InputT IO v
runAlgebra (LinePrewritten String
p String
s1 String
s2 String -> InputT IO v
w) = String -> (String, String) -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> (String, String) -> InputT m (Maybe String)
getInputLineWithInitial String
p (String
s1,String
s2) InputT IO (Maybe String)
-> (Maybe String -> InputT IO v) -> InputT IO v
forall a b. InputT IO a -> (a -> InputT IO b) -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> InputT IO v) -> Maybe String -> InputT IO v
forall {a} {b}. (a -> b) -> Maybe a -> b
mEof String -> InputT IO v
w
instance Run (InputT IO) Password        where runAlgebra :: forall v. Password (InputT IO v) -> InputT IO v
runAlgebra (Password String
p Maybe Char
mc String -> InputT IO v
w)          = Maybe Char -> String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Maybe Char -> String -> InputT m (Maybe String)
getPassword Maybe Char
mc String
p                  InputT IO (Maybe String)
-> (Maybe String -> InputT IO v) -> InputT IO v
forall a b. InputT IO a -> (a -> InputT IO b) -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> InputT IO v) -> Maybe String -> InputT IO v
forall {a} {b}. (a -> b) -> Maybe a -> b
mEof String -> InputT IO v
w
instance Run (InputT IO) ArbitraryIO     where runAlgebra :: forall v. ArbitraryIO (InputT IO v) -> InputT IO v
runAlgebra (ArbitraryIO IO a
iov a -> InputT IO v
f)        = IO a -> InputT IO a
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
iov                        InputT IO a -> (a -> InputT IO v) -> InputT IO v
forall a b. InputT IO a -> (a -> InputT IO b) -> InputT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> InputT IO v
f
instance Run (InputT IO) WithSettings    where runAlgebra :: forall v. WithSettings (InputT IO v) -> InputT IO v
runAlgebra (WithSettings Settings IO
sets InputT IO v
w)      = IO v -> InputT IO v
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Settings IO -> InputT IO v -> IO v
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT Settings IO
sets InputT IO v
w)

mEof :: (a -> b) -> Maybe a -> b
mEof = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UnexpectedEOF -> b
forall a e. Exception e => e -> a
throw UnexpectedEOF
UnexpectedEOF)    


-- | A simple identity function, used to restrict types if the type inferred by GHC is too general.
--   You could achieve the same effect with a type signature, but this is slightly less typing.
haskeline :: Wizard Haskeline a -> Wizard Haskeline a
haskeline :: forall a. Wizard Haskeline a -> Wizard Haskeline a
haskeline = Wizard Haskeline a -> Wizard Haskeline a
forall a. a -> a
id