module Console.Garepinoh.GenMain
( genMain
, module Console.Garepinoh.Calculate
) where
import Control.Monad.IO.Class (liftIO)
import Data.List (find,intercalate,tails)
import Data.Maybe (isNothing)
import System.Environment (getArgs)
import System.Console.Haskeline (runInputT,defaultSettings,InputT,getInputLine)
import Console.Garepinoh.Calculate
genMain :: (Read t, Show t) => Prelude t-> IO ()
genMain fl =
getArgs >>= \as ->
runInputT defaultSettings $ loop as [] fl >> return ()
loop :: (Read t, Show t)
=> [String] -> [String] -> Prelude t
-> InputT IO ()
loop as postulates p =
getLn as >>= \mayLn ->
case fmap words mayLn of
Nothing
-> return ()
Just []
-> continue
Just (",,":_)
-> continue
Just (",":name:[])
| repl
-> loop as (name:postulates) p
| otherwise
-> return ()
Just (",":name:def@(_:_))
| repl
-> either
((>> continue) . liftIO . putStrLn)
(loop as postulates)
(addDef name def postulates p)
| otherwise
-> return ()
Just ((',':',':cmd):ws)
| cmd `elem` helpList
-> (>> continue) $ liftIO $ putStr $ helpText p
| cmd `elem` cmndList
-> (>> continue) $ liftIO $ putStr cmndText
| cmd `elem` postList
-> (>> continue) $ liftIO $ putStr $ postText p postulates
| cmd `elem` funcList
-> (>> continue) $ liftIO $ putStr $ funcText p
| cmd `elem` exitList
-> return ()
| cmd `elem` ["l","load"]
-> loop [] postulates p
| cmd `elem` ["scan","debug","trace"]
-> (>> continue) $ mapM_ calc $
map reverse $ reverse $ tails $ reverse ws
| otherwise
-> continue
Just ws
-> calc ws
>> continue
where
continue
| repl
= loop as postulates p
| otherwise
= return ()
calc ws = liftIO $ putStrLn $ either
((" ,, Error: "++).(++"\n ,, Try typing \",,help\"."))
((" ,, "++) . show . reverse)
(calculate p ws)
repl = null as
addDef :: (Read t, Show t)
=> String -> [String] -> [String] -> Prelude t -> Either String (Prelude t)
addDef name def postulates p =
case find invalid def of
Nothing -> Right $ Func
{ symb = NEL name []
, func = map Ref def
} : p
Just x
| x `elem` postulates
-> Left $ " ,, Error: " ++ show x ++ " postulated but not defined."
| otherwise
-> Left $ " ,, Error: Unkown function " ++ show x ++ "."
where
invalid (',':d) = invalid d
invalid d = and
[ d `notElem` concatMap (list . symb) p
, isNothing $ asTypeOf (value d) $ Just $ Fu $ head p
, d /= name
, d `notElem` postulates
]
getLn :: [String] -> InputT IO (Maybe String)
getLn as
| null as = getInputLine ""
| otherwise = return $ Just $ unwords as
funcText, helpText :: (Read t, Show t) => Prelude t -> String
funcText p = intercalate "\n"
[ " ,, Functions (and Variables):"
, printList p (list . symb)
]
helpText p = funcText p ++ cmndText
cmndText :: String
cmndText = intercalate "\n"
[ " ,, Commands:"
, " ,, Use commands by typing \",,<command>\" as the first word."
, printList [exitList,helpList,funcList,cmndList,postList] id
]
postText :: Prelude t -> [String] -> String
postText prelude postulates = intercalate "\n"
[ " ,, Postulates:"
, flip printList id $ map return $ filter (`notElem` preluded) postulates
]
where
preluded = concatMap (list . symb) prelude
exitList, funcList, helpList, cmndList, postList :: [String]
exitList = ["quit","q","exit","x"]
helpList = ["help","h"]
funcList = ["func","f","functions"]
cmndList = ["cmnd","c","commands"]
postList = ["post","p","postulates"]
printList :: [a] -> (a -> [String]) -> String
printList l f = flip concatMap l
$ (++"\n") . (" ,, "++) . intercalate ", " . f