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 -- pretty print result
	, ppCommand :: Bool -- pretty print command
	, sResult :: Bool -- show result
	, sCommand :: Bool -- show command
	, echo :: Bool -- echo input
	, pErrors :: Bool -- print errors
	, tolerant :: Bool -- go on after error
	} 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 -- EOF
		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)

				 -- no error, but no command either (empty line or comment)
				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 ())