{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS -fno-warn-orphans #-} module Hell.Types where import Control.Applicative import Control.Monad.Reader import Data.Default import Data.IORef import GhcMonad import System.Console.Haskeline.History -- | Shell config. data Config = Config { configImports :: ![String] -- ^ Starting imports. , configWelcome :: String -- ^ A welcome string. , configHistory :: FilePath , configPrompt :: String -> FilePath -> Hell String -- ^ An action to generate the prompt. } -- | State of the shell. data HellState = HellState { stateConfig :: !Config , stateHistory :: !(IORef History) , stateUsername :: !String , stateHome :: !FilePath , stateFunctions :: ![String] } -- | Hell monad, containing user information and things like that. newtype Hell a = Hell {runHell :: ReaderT HellState Ghc a} deriving (Monad,MonadIO,Functor,MonadReader HellState) instance Default Config where def = Config {configImports = ["import Prelude" ,"import Data.List" ,"import Data.Ord" ,"import Data.Conduit.Shell" ,"import System.Directory" ,"import Data.Conduit" ,"import qualified Data.Conduit.List as CL" ,"import Data.Bifunctor" ,"import qualified Data.Conduit.Binary as CB" ,"import qualified Data.ByteString.Char8 as S8" ,"import Control.Monad" ,"import Data.Function" ,"import Hell"] ,configWelcome = "Welcome to Hell!" ,configPrompt = \username pwd -> return (username ++ ":" ++ pwd ++ "$ ") ,configHistory = "~/.hell-history"} -- | Hopefully this shouldn't be a problem because while this is a -- library it has a very narrow use-case. #if __GLASGOW_HASKELL__ == 706 instance MonadIO Ghc where liftIO = GhcMonad.liftIO #endif