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
data UnexpectedEOF = UnexpectedEOF deriving (Show, Typeable)
instance Exception UnexpectedEOF
newtype Haskeline a = Haskeline (( Output
:+: OutputLn
:+: Line
:+: Character
:+: LinePrewritten
:+: Password
:+: ArbitraryIO
:+: WithSettings) a)
deriving ( (:<:) Output
, (:<:) OutputLn
, (:<:) Line
, (:<:) Character
, (:<:) LinePrewritten
, (:<:) Password
, (:<:) ArbitraryIO
, (:<:) WithSettings
, Functor
, Run (InputT IO)
)
withSettings :: (WithSettings :<: b) => Settings IO -> Wizard b a -> Wizard b a
withSettings sets (Wizard (MaybeT v)) = Wizard $ MaybeT $ inject (WithSettings sets v)
data WithSettings w = WithSettings (Settings IO) w deriving (Functor)
instance Run (InputT IO) Output where runAlgebra (Output s w) = outputStr s >> w
instance Run (InputT IO) OutputLn where runAlgebra (OutputLn s w) = outputStrLn s >> w
instance Run (InputT IO) Line where runAlgebra (Line s w) = getInputLine s >>= mEof w
instance Run (InputT IO) Character where runAlgebra (Character s w) = getInputChar s >>= mEof w
instance Run (InputT IO) LinePrewritten where runAlgebra (LinePrewritten p s1 s2 w) = getInputLineWithInitial p (s1,s2) >>= mEof w
instance Run (InputT IO) Password where runAlgebra (Password p mc w) = getPassword mc p >>= mEof w
instance Run (InputT IO) ArbitraryIO where runAlgebra (ArbitraryIO iov f) = liftIO iov >>= f
instance Run (InputT IO) WithSettings where runAlgebra (WithSettings sets w) = liftIO (runInputT sets w)
mEof = maybe (throw UnexpectedEOF)
haskeline :: Wizard Haskeline a -> Wizard Haskeline a
haskeline = id