module Main where
import Control.Monad.Trans
import Control.Monad.State
import Control.Exception
import Data.List
import Data.Foldable (forM_)
import System.Directory
import System.Console.Haskeline
import Text.ParserCombinators.Parsec hiding (try)
import Format
import Interpreter
import Environment
import Options hiding (defaultOptions)
main :: IO ()
main =
runCommand $ \opts args -> do
let initialEnv = if flagLibs opts then defaultEnv else librariesEnv
if flagVersion opts
then putStrLn versionText
else case args of
[] ->
runInputT
defaultSettings
(outputStrLn initialText >> interpreterLoop initialEnv)
[filename] -> executeFile filename
_ -> putStrLn "Wrong number of arguments"
interpreterLoop :: Environment -> InputT IO ()
interpreterLoop environment = do
minput <- getInputLine promptText
let interpreteraction =
case minput of
Nothing -> Quit
Just "" -> Interpret EmptyLine
Just input ->
case parse interpreteractionParser "" (preformat input) of
Left _ -> Interpret Error
Right a -> a
newenvironment <- executeAction environment interpreteraction
forM_ newenvironment interpreterLoop
executeAction :: Environment -> InterpreterAction -> InputT IO (Maybe Environment)
executeAction environment interpreteraction =
case interpreteraction of
Interpret action ->
case runState (act action) environment of
(output, newenv) -> do
outputActions newenv output
return $ Just newenv
Load modulename -> do
readallmoduledeps <- lift $ readAllModuleDepsRecursively [modulename]
case readallmoduledeps of
Nothing -> do
outputStrLn errorNotFoundText
return $ Just environment
Just readallmodules -> do
let modules = nub readallmodules
files <- lift $ mapM findFilename modules
case sequence files of
Nothing -> do
outputStrLn errorNotFoundText
return $ Just environment
Just allfiles -> do
maybeactions <- fmap concat . sequence <$> lift (mapM loadFile allfiles)
case maybeactions of
Nothing -> do
outputStrLn "Error loading file"
return $ Just environment
Just actions ->
case runState (multipleAct actions) environment of
(output, newenv) -> do
outputActions newenv output
return $ Just newenv
Quit -> return Nothing
outputActions :: Environment -> [String] -> InputT IO ()
outputActions environment output = do
outputStr (if getColor environment then formatFormula else "")
mapM_ (outputStr . format) output
outputStr end
where
format = formatColor
formatColor s
| getColor environment = s
| otherwise = unlines $ map decolor $ lines s
loadFile :: Filename -> IO (Maybe [Action])
loadFile filename = do
putStrLn $ formatLoading ++ "Loading " ++ filename ++ "..." ++ end
input <- try $ readFile filename :: IO (Either IOException String)
case input of
Left _ -> return Nothing
Right inputs -> do
let parsing = map (parse actionParser "" . preformat) . filter (/="") . lines $ inputs
let actions = map (\x -> case x of
Left _ -> Nothing
Right a -> Just a) parsing
return $ sequence actions
executeFile :: Filename -> IO ()
executeFile filename = do
maybeloadfile <- loadFile filename
case maybeloadfile of
Nothing -> putStrLn "Error loading file"
Just actions ->
case runState (multipleAct actions) defaultEnv of
(outputs, _) -> mapM_ putStr outputs
readFileDependencies :: Filename -> IO [Modulename]
readFileDependencies filename = do
input <- try $ readFile filename :: IO (Either IOException String)
case input of
Left _ -> return []
Right inputs -> return $
map (drop 9) (filter (isPrefixOf "#INCLUDE ") $ filter (/="") $ lines inputs)
readAllModuleDeps :: [Modulename] -> IO (Maybe [Modulename])
readAllModuleDeps modulenames = do
files <- mapM findFilename modulenames
deps <- mapM (mapM readFileDependencies) files
return (concat <$> sequence deps)
readAllModuleDepsRecursively :: [Modulename] -> IO (Maybe [Modulename])
readAllModuleDepsRecursively modulenames = do
maybenewmodulenames <- readAllModuleDeps modulenames
case maybenewmodulenames of
Nothing -> return Nothing
Just newmodulenames -> do
let allmodulenames = nub (newmodulenames ++ modulenames)
if modulenames == allmodulenames
then return (Just modulenames)
else readAllModuleDepsRecursively allmodulenames
findFilename :: Modulename -> IO (Maybe Filename)
findFilename s = do
appdir <- getAppUserDataDirectory "mikrokosmos"
homedir <- getHomeDirectory
headMaybe <$> filterM doesFileExist
[ "lib/" ++ s ++ ".mkr"
, "./" ++ s ++ ".mkr"
, appdir ++ "/" ++ s ++ ".mkr"
, homedir ++ "/" ++ s ++ ".mkr"
, "/usr/lib/mikrokosmos/" ++ s ++ ".mkr"
]
where
headMaybe [] = Nothing
headMaybe (x:_) = Just x
data MainFlags = MainFlags
{ flagExec :: String
, flagVersion :: Bool
, flagLibs :: Bool
}
instance Options MainFlags where
defineOptions = pure MainFlags
<*> simpleOption "exec" "" "A file to execute and show its results"
<*> simpleOption "version" False "Show program version"
<*> simpleOption "no-libs" False "Runs mikrokosmos without standard libraries"