module Language.CalDims.Program (getUserState, loop, OutputMode (..), omRun, prompt, defMain) where
import Text.ParserCombinators.Parsec
import qualified Data.List as List
import System.IO
import qualified System.Directory as Dir
import System.Environment as E
import System.Console.Readline
import Control.Monad
import System.Console.GetOpt
import Language.CalDims.Action
import Language.CalDims.State as S
import Language.CalDims.Types
import qualified Language.CalDims.Texts as Texts
import Language.CalDims.Helpers
import Language.CalDims.Misc
import Language.CalDims.Texts
prompt :: String
prompt = "> "
getLine' :: Handle -> IO (Maybe String)
getLine' h = do
i <- hIsTerminalDevice h
if i then readline prompt else catch (do {l <- hGetLine h; return $ Just l}) (\_ -> return Nothing)
data OutputMode = OutputMode
{ ppResult :: Bool
, ppCommand :: Bool
, sResult :: Bool
, sCommand :: Bool
, echo :: Bool
, pErrors :: Bool
, tolerant :: Bool
} deriving (Read, Show)
omPrelude, omRun :: OutputMode
omPrelude = OutputMode False False False False False True False
omRun = OutputMode True False False False False True True
loop :: OutputMode -> Handle -> S.State -> IO S.State
loop om h state = do
line' <- getLine' h
case line' of
Nothing -> return state
Just line -> do
addHistory line
when (echo om) (putStrLn $ prompt ++ line)
case runParser parseLine state "" line of
Left e -> do
when (pErrors om) (putStrLn . last . lines . show $ e)
if (tolerant om)
then loop om h state
else error (show e)
Right Nothing -> loop om h state
Right (Just command) -> do
when (sCommand om) (print command)
when (ppCommand om) (putStrLn $ pretty command)
case run state command of
(Left e, _) -> do
when (pErrors om) (putStrLn e)
if tolerant om
then loop om h state
else error e
(Right res, newState) -> do
when (sResult om) (print res)
when (ppResult om) (putStrLn $ pretty res)
loop om h newState
getUserState :: Maybe String -> IO S.State
getUserState mfn = do
sdir <- Dir.getCurrentDirectory
filename <- case mfn of
Nothing -> (do
let
file = "prelude.cal"
dir <- Dir.getAppUserDataDirectory "CalDims"
Dir.createDirectoryIfMissing True dir
Dir.setCurrentDirectory dir
exists <- Dir.doesFileExist file
unless exists (do
handle <- openFile file WriteMode
hPutStr handle Texts.preludeText
hClose handle)
return file)
Just fns -> return fns
handle <- openFile filename ReadMode
Dir.setCurrentDirectory sdir
loop omPrelude handle start
data CliArg = DoEcho | Blank | DisplayHelp deriving Eq
exit :: [String] -> IO a
exit s = error (unlines s)
defMain :: IO()
defMain = do
interactive <- hIsTerminalDevice stdin
when interactive (do
putStrLn Texts.welcomeText
hFlush stdout)
args <- E.getArgs
let
descr =
[ Option "e" ["echo"] (NoArg DoEcho) "echo input line"
, Option "b" ["blank"] (NoArg Blank) "load no configuration file"
, Option "h" ["help"] (NoArg DisplayHelp) "display help" ]
(opts, fns, errs) = getOpt RequireOrder descr args
when (not $ null errs) (exit (errs ++ [usageInfo "caldims [OPTIONS] FILE" descr]))
let omRun_ = if_
(DoEcho `elem` opts)
(omRun {echo = True})
omRun
if DisplayHelp `elem` opts then print helpText else (do
s <- case (Blank `elem` opts, fns) of
(False, []) -> getUserState Nothing
(False, [filename]) -> getUserState (Just filename)
(True, []) -> return start
(_, (_:_:_)) -> exit ["too many FILE arguments"]
(True, (_:_)) -> exit ["blank start requested, but filename given."]
loop omRun_ stdin s
return ())