Commit 450f3ced authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky
Browse files

Replaced MessageM monad with CYT monads and moved CYT monads to curry-base

parent e3a3648e
...@@ -4,6 +4,8 @@ Change log for curry-frontend ...@@ -4,6 +4,8 @@ Change log for curry-frontend
Under development Under development
================= =================
* Replaced MessageM monad with CYT monads and moved CYT monads to curry-base
* Implemented warnings for overlapping module aliases - fixes #14 * Implemented warnings for overlapping module aliases - fixes #14
* The check for overlapping rules has been completely refactored and * The check for overlapping rules has been completely refactored and
......
...@@ -6,12 +6,11 @@ module Base.Messages ...@@ -6,12 +6,11 @@ module Base.Messages
, internalError, errorMessage, errorMessages , internalError, errorMessage, errorMessages
-- * creating messages -- * creating messages
, Message, message, posMessage , Message, message, posMessage
, MonadIO (..), CYIO, CYT, left, right, runEitherCYIO , MonadIO (..)
) where ) where
import Control.Monad (unless, when) import Control.Monad (unless, when)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Either (EitherT, left, right, runEitherT)
import Data.List (sort) import Data.List (sort)
import System.IO (hFlush, hPutStrLn, stderr, stdout) import System.IO (hFlush, hPutStrLn, stderr, stdout)
import System.Exit (exitFailure) import System.Exit (exitFailure)
...@@ -20,17 +19,6 @@ import Curry.Base.Message ( Message, message, posMessage, ppMessage ...@@ -20,17 +19,6 @@ import Curry.Base.Message ( Message, message, posMessage, ppMessage
, ppMessages, ppWarning, ppError) , ppMessages, ppWarning, ppError)
import CompilerOpts (Options (..), WarnOpts (..), Verbosity (..)) import CompilerOpts (Options (..), WarnOpts (..), Verbosity (..))
type CYT m a = EitherT [Message] m a
type CYIO a = EitherT [Message] IO a
runEitherCYIO :: CYIO a -> IO a
runEitherCYIO act = do
res <- runEitherT act
case res of
Left errs -> abortWithMessages errs
Right val -> return val
status :: MonadIO m => Options -> String -> m () status :: MonadIO m => Options -> String -> m ()
status opts msg = unless (optVerbosity opts < VerbStatus) (putMsg msg) status opts msg = unless (optVerbosity opts < VerbStatus) (putMsg msg)
......
...@@ -21,6 +21,7 @@ import qualified Checks.SyntaxCheck as SC (syntaxCheck) ...@@ -21,6 +21,7 @@ import qualified Checks.SyntaxCheck as SC (syntaxCheck)
import qualified Checks.TypeCheck as TC (typeCheck) import qualified Checks.TypeCheck as TC (typeCheck)
import qualified Checks.WarnCheck as WC (warnCheck) import qualified Checks.WarnCheck as WC (warnCheck)
import Curry.Base.Monad
import Curry.Syntax (Module (..), Interface (..)) import Curry.Syntax (Module (..), Interface (..))
import Base.Messages import Base.Messages
...@@ -31,8 +32,8 @@ type Check m a = Options -> CompilerEnv -> a -> CYT m (CompilerEnv, a) ...@@ -31,8 +32,8 @@ type Check m a = Options -> CompilerEnv -> a -> CYT m (CompilerEnv, a)
interfaceCheck :: Monad m => Check m Interface interfaceCheck :: Monad m => Check m Interface
interfaceCheck _ env intf interfaceCheck _ env intf
| null msgs = right (env, intf) | null msgs = ok (env, intf)
| otherwise = left msgs | otherwise = failMessages msgs
where msgs = IC.interfaceCheck (opPrecEnv env) (tyConsEnv env) where msgs = IC.interfaceCheck (opPrecEnv env) (tyConsEnv env)
(valueEnv env) intf (valueEnv env) intf
...@@ -43,8 +44,8 @@ interfaceCheck _ env intf ...@@ -43,8 +44,8 @@ interfaceCheck _ env intf
-- * Environment: remains unchanged -- * Environment: remains unchanged
kindCheck :: Monad m => Check m Module kindCheck :: Monad m => Check m Module
kindCheck _ env (Module ps m es is ds) kindCheck _ env (Module ps m es is ds)
| null msgs = right (env, Module ps m es is ds') | null msgs = ok (env, Module ps m es is ds')
| otherwise = left msgs | otherwise = failMessages msgs
where (ds', msgs) = KC.kindCheck (moduleIdent env) (tyConsEnv env) ds where (ds', msgs) = KC.kindCheck (moduleIdent env) (tyConsEnv env) ds
-- |Check for a correct syntax. -- |Check for a correct syntax.
...@@ -54,8 +55,8 @@ kindCheck _ env (Module ps m es is ds) ...@@ -54,8 +55,8 @@ kindCheck _ env (Module ps m es is ds)
-- * Environment: remains unchanged -- * Environment: remains unchanged
syntaxCheck :: Monad m => Check m Module syntaxCheck :: Monad m => Check m Module
syntaxCheck opts env mdl syntaxCheck opts env mdl
| null msgs = right (env { extensions = exts }, mdl') | null msgs = ok (env { extensions = exts }, mdl')
| otherwise = left msgs | otherwise = failMessages msgs
where ((mdl', exts), msgs) = SC.syntaxCheck opts (valueEnv env) where ((mdl', exts), msgs) = SC.syntaxCheck opts (valueEnv env)
(tyConsEnv env) mdl (tyConsEnv env) mdl
...@@ -66,8 +67,8 @@ syntaxCheck opts env mdl ...@@ -66,8 +67,8 @@ syntaxCheck opts env mdl
-- * Environment: The operator precedence environment is updated -- * Environment: The operator precedence environment is updated
precCheck :: Monad m => Check m Module precCheck :: Monad m => Check m Module
precCheck _ env (Module ps m es is ds) precCheck _ env (Module ps m es is ds)
| null msgs = right (env { opPrecEnv = pEnv' }, Module ps m es is ds') | null msgs = ok (env { opPrecEnv = pEnv' }, Module ps m es is ds')
| otherwise = left msgs | otherwise = failMessages msgs
where (ds', pEnv', msgs) = PC.precCheck (moduleIdent env) (opPrecEnv env) ds where (ds', pEnv', msgs) = PC.precCheck (moduleIdent env) (opPrecEnv env) ds
-- |Apply the correct typing of the module. -- |Apply the correct typing of the module.
...@@ -75,16 +76,16 @@ precCheck _ env (Module ps m es is ds) ...@@ -75,16 +76,16 @@ precCheck _ env (Module ps m es is ds)
-- environments are updated. -- environments are updated.
typeCheck :: Monad m => Check m Module typeCheck :: Monad m => Check m Module
typeCheck _ env mdl@(Module _ _ _ _ ds) typeCheck _ env mdl@(Module _ _ _ _ ds)
| null msgs = right (env { tyConsEnv = tcEnv', valueEnv = tyEnv' }, mdl) | null msgs = ok (env { tyConsEnv = tcEnv', valueEnv = tyEnv' }, mdl)
| otherwise = left msgs | otherwise = failMessages msgs
where (tcEnv', tyEnv', msgs) = TC.typeCheck (moduleIdent env) where (tcEnv', tyEnv', msgs) = TC.typeCheck (moduleIdent env)
(tyConsEnv env) (valueEnv env) ds (tyConsEnv env) (valueEnv env) ds
-- |Check the export specification -- |Check the export specification
exportCheck :: Monad m => Check m Module exportCheck :: Monad m => Check m Module
exportCheck _ env (Module ps m es is ds) exportCheck _ env (Module ps m es is ds)
| null msgs = right (env, Module ps m es' is ds) | null msgs = ok (env, Module ps m es' is ds)
| otherwise = left msgs | otherwise = failMessages msgs
where (es', msgs) = EC.exportCheck (moduleIdent env) (aliasEnv env) where (es', msgs) = EC.exportCheck (moduleIdent env) (aliasEnv env)
(tyConsEnv env) (valueEnv env) es (tyConsEnv env) (valueEnv env) es
......
...@@ -21,6 +21,7 @@ import Data.Maybe (catMaybes, mapMaybe) ...@@ -21,6 +21,7 @@ import Data.Maybe (catMaybes, mapMaybe)
import System.FilePath (normalise) import System.FilePath (normalise)
import Curry.Base.Ident import Curry.Base.Ident
import Curry.Base.Monad
import Curry.Base.Position (Position) import Curry.Base.Position (Position)
import Curry.Base.Pretty import Curry.Base.Pretty
import Curry.Files.Filenames import Curry.Files.Filenames
...@@ -50,8 +51,8 @@ findCurry :: Options -> String -> CYIO FilePath ...@@ -50,8 +51,8 @@ findCurry :: Options -> String -> CYIO FilePath
findCurry opts s = do findCurry opts s = do
mbTarget <- findFile `orIfNotFound` findModule mbTarget <- findFile `orIfNotFound` findModule
case mbTarget of case mbTarget of
Nothing -> left [complaint] Nothing -> failMessages [complaint]
Just fn -> right fn Just fn -> ok fn
where where
canBeFile = isCurryFilePath s canBeFile = isCurryFilePath s
canBeModule = isValidModuleName s canBeModule = isValidModuleName s
...@@ -113,15 +114,15 @@ processPragmas opts0 ps = foldM processPragma opts0 ...@@ -113,15 +114,15 @@ processPragmas opts0 ps = foldM processPragma opts0
where where
processPragma opts (p, s) processPragma opts (p, s)
| not (null unknownFlags) | not (null unknownFlags)
= left [errUnknownOptions p unknownFlags] = failMessages [errUnknownOptions p unknownFlags]
| optMode opts /= optMode opts' | optMode opts /= optMode opts'
= left [errIllegalOption p "Cannot change mode"] = failMessages [errIllegalOption p "Cannot change mode"]
| optLibraryPaths opts /= optLibraryPaths opts' | optLibraryPaths opts /= optLibraryPaths opts'
= left [errIllegalOption p "Cannot change library path"] = failMessages [errIllegalOption p "Cannot change library path"]
| optImportPaths opts /= optImportPaths opts' | optImportPaths opts /= optImportPaths opts'
= left [errIllegalOption p "Cannot change import path"] = failMessages [errIllegalOption p "Cannot change import path"]
| optTargetTypes opts /= optTargetTypes opts' | optTargetTypes opts /= optTargetTypes opts'
= left [errIllegalOption p "Cannot change target type"] = failMessages [errIllegalOption p "Cannot change target type"]
| otherwise | otherwise
= return opts' = return opts'
where where
...@@ -196,8 +197,8 @@ smake dests deps actOutdated actUpToDate = do ...@@ -196,8 +197,8 @@ smake dests deps actOutdated actUpToDate = do
cancelMissing :: (FilePath -> IO (Maybe a)) -> FilePath -> CYIO a cancelMissing :: (FilePath -> IO (Maybe a)) -> FilePath -> CYIO a
cancelMissing act f = liftIO (act f) >>= \res -> case res of cancelMissing act f = liftIO (act f) >>= \res -> case res of
Nothing -> left [errModificationTime f] Nothing -> failMessages [errModificationTime f]
Just val -> right val Just val -> ok val
errUnknownOptions :: Position -> [String] -> Message errUnknownOptions :: Position -> [String] -> Message
errUnknownOptions p errs = posMessage p $ errUnknownOptions p errs = posMessage p $
......
...@@ -24,6 +24,7 @@ import Data.List (isSuffixOf, nub) ...@@ -24,6 +24,7 @@ import Data.List (isSuffixOf, nub)
import qualified Data.Map as Map (Map, empty, insert, lookup, toList) import qualified Data.Map as Map (Map, empty, insert, lookup, toList)
import Curry.Base.Ident import Curry.Base.Ident
import Curry.Base.Monad
import Curry.Base.Pretty import Curry.Base.Pretty
import Curry.Files.Filenames import Curry.Files.Filenames
import Curry.Files.PathUtils import Curry.Files.PathUtils
...@@ -53,8 +54,8 @@ flatDeps :: Options -> FilePath -> CYIO [(ModuleIdent, Source)] ...@@ -53,8 +54,8 @@ flatDeps :: Options -> FilePath -> CYIO [(ModuleIdent, Source)]
flatDeps opts fn = do flatDeps opts fn = do
sEnv <- deps opts Map.empty fn sEnv <- deps opts Map.empty fn
case flattenDeps sEnv of case flattenDeps sEnv of
(env, [] ) -> right env (env, [] ) -> ok env
(_ , errs) -> left errs (_ , errs) -> failMessages errs
-- |Retrieve the dependencies of a source file as a 'SourceEnv' -- |Retrieve the dependencies of a source file as a 'SourceEnv'
deps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv deps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
...@@ -124,17 +125,16 @@ moduleIdentDeps opts sEnv m = case Map.lookup m sEnv of ...@@ -124,17 +125,16 @@ moduleIdentDeps opts sEnv m = case Map.lookup m sEnv of
| otherwise -> do | otherwise -> do
hdr@(Module _ m' _ _ _) <- readHeader fn hdr@(Module _ m' _ _ _) <- readHeader fn
if (m == m') then moduleDeps opts sEnv fn hdr if (m == m') then moduleDeps opts sEnv fn hdr
else left [errWrongModule m m'] else failMessages [errWrongModule m m']
readHeader :: FilePath -> CYIO Module readHeader :: FilePath -> CYIO Module
readHeader fn = do readHeader fn = do
mbFile <- liftIO $ readModule fn mbFile <- liftIO $ readModule fn
case mbFile of case mbFile of
Nothing -> left [errMissingFile fn] Nothing -> failMessages [errMissingFile fn]
Just src -> do Just src -> do
case parseHeader fn src of hdr <- liftCYM $ parseHeader fn src
Left err -> left [err] return $ patchModuleId fn hdr
Right hdr -> return $ patchModuleId fn hdr
-- If we want to compile the program instead of generating Makefile -- If we want to compile the program instead of generating Makefile
-- dependencies, the environment has to be sorted topologically. Note -- dependencies, the environment has to be sorted topologically. Note
......
...@@ -20,6 +20,7 @@ import Data.Maybe (fromMaybe, isJust) ...@@ -20,6 +20,7 @@ import Data.Maybe (fromMaybe, isJust)
import System.FilePath ((</>), dropFileName, takeBaseName) import System.FilePath ((</>), dropFileName, takeBaseName)
import Curry.Base.Ident (QualIdent (..), unqualify) import Curry.Base.Ident (QualIdent (..), unqualify)
import Curry.Base.Monad
import Curry.Base.Pretty (text) import Curry.Base.Pretty (text)
import Curry.Files.PathUtils (readModule, lookupCurryFile) import Curry.Files.PathUtils (readModule, lookupCurryFile)
import Curry.Syntax (Module, lexSource) import Curry.Syntax (Module, lexSource)
...@@ -52,11 +53,9 @@ filename2program opts f = do ...@@ -52,11 +53,9 @@ filename2program opts f = do
case mbModule of case mbModule of
Nothing -> left [message $ text $ "Missing file: " ++ f] Nothing -> left [message $ text $ "Missing file: " ++ f]
Just src -> do Just src -> do
case lexSource f src of toks <- liftCYM $ lexSource f src
Left err -> left [err] typed <- fullParse opts f src
Right toks -> do return (genProgram typed toks)
typed <- fullParse opts f src
return (genProgram typed toks)
-- |Return the syntax tree of the source program 'src' (type 'Module'; see -- |Return the syntax tree of the source program 'src' (type 'Module'; see
-- Module "CurrySyntax").after inferring the types of identifiers. -- Module "CurrySyntax").after inferring the types of identifiers.
......
...@@ -23,6 +23,7 @@ import Data.Maybe ...@@ -23,6 +23,7 @@ import Data.Maybe
import qualified Data.Set as Set import qualified Data.Set as Set
import Curry.Base.Ident import Curry.Base.Ident
import Curry.Base.Monad
import Curry.Base.Position import Curry.Base.Position
import Curry.Base.Pretty import Curry.Base.Pretty
import Curry.Syntax import Curry.Syntax
......
...@@ -29,6 +29,7 @@ import qualified Control.Monad.State as S (StateT, execStateT, gets, modify) ...@@ -29,6 +29,7 @@ import qualified Control.Monad.State as S (StateT, execStateT, gets, modify)
import qualified Data.Map as M (insert, member) import qualified Data.Map as M (insert, member)
import Curry.Base.Ident import Curry.Base.Ident
import Curry.Base.Monad
import Curry.Base.Position import Curry.Base.Position
import Curry.Base.Pretty import Curry.Base.Pretty
import Curry.Files.PathUtils import Curry.Files.PathUtils
...@@ -49,8 +50,8 @@ data LoaderState = LoaderState ...@@ -49,8 +50,8 @@ data LoaderState = LoaderState
} }
-- Report an error. -- Report an error.
report :: Message -> IntfLoader () report :: [Message] -> IntfLoader ()
report msg = S.modify $ \ s -> s { errs = msg : errs s } report msg = S.modify $ \ s -> s { errs = msg ++ errs s }
-- Check whether a module interface is already loaded. -- Check whether a module interface is already loaded.
loaded :: ModuleIdent -> IntfLoader Bool loaded :: ModuleIdent -> IntfLoader Bool
...@@ -72,7 +73,7 @@ loadInterfaces :: [FilePath] -- ^ 'FilePath's to search in for interfaces ...@@ -72,7 +73,7 @@ loadInterfaces :: [FilePath] -- ^ 'FilePath's to search in for interfaces
-> CYIO InterfaceEnv -> CYIO InterfaceEnv
loadInterfaces paths (Module _ m _ is _) = do loadInterfaces paths (Module _ m _ is _) = do
res <- liftIO $ S.execStateT load (LoaderState initInterfaceEnv paths []) res <- liftIO $ S.execStateT load (LoaderState initInterfaceEnv paths [])
if null (errs res) then right (iEnv res) else left (reverse $ errs res) if null (errs res) then ok (iEnv res) else failMessages (reverse $ errs res)
where load = mapM_ (loadInterface [m]) [(p, m') | ImportDecl p m' _ _ _ <- is] where load = mapM_ (loadInterface [m]) [(p, m') | ImportDecl p m' _ _ _ <- is]
-- |Load an interface into the given environment. -- |Load an interface into the given environment.
...@@ -86,14 +87,14 @@ loadInterfaces paths (Module _ m _ is _) = do ...@@ -86,14 +87,14 @@ loadInterfaces paths (Module _ m _ is _) = do
-- for in the import paths and compiled. -- for in the import paths and compiled.
loadInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> IntfLoader () loadInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> IntfLoader ()
loadInterface ctxt imp@(p, m) loadInterface ctxt imp@(p, m)
| m `elem` ctxt = report $ errCyclicImport p $ m : takeWhile (/= m) ctxt | m `elem` ctxt = report [errCyclicImport p (m : takeWhile (/= m) ctxt)]
| otherwise = do | otherwise = do
isLoaded <- loaded m isLoaded <- loaded m
unless isLoaded $ do unless isLoaded $ do
paths <- searchPaths paths <- searchPaths
mbIntf <- liftIO $ lookupCurryInterface paths m mbIntf <- liftIO $ lookupCurryInterface paths m
case mbIntf of case mbIntf of
Nothing -> report (errInterfaceNotFound p m) Nothing -> report [errInterfaceNotFound p m]
Just fn -> compileInterface ctxt imp fn Just fn -> compileInterface ctxt imp fn
-- |Compile an interface by recursively loading its dependencies. -- |Compile an interface by recursively loading its dependencies.
...@@ -105,15 +106,15 @@ compileInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> FilePath ...@@ -105,15 +106,15 @@ compileInterface :: [ModuleIdent] -> (Position, ModuleIdent) -> FilePath
compileInterface ctxt (p, m) fn = do compileInterface ctxt (p, m) fn = do
mbSrc <- liftIO $ readModule fn mbSrc <- liftIO $ readModule fn
case mbSrc of case mbSrc of
Nothing -> report $ errInterfaceNotFound p m Nothing -> report [errInterfaceNotFound p m]
Just src -> case parseInterface fn src of Just src -> case runCYM (parseInterface fn src) of
Left err -> report err Left err -> report err
Right intf@(Interface n is _) -> Right intf@(Interface n is _) ->
if (m /= n) if (m /= n)
then report $ errWrongInterface (first fn) m n then report [errWrongInterface (first fn) m n]
else do else do
let (intf', intfErrs) = intfSyntaxCheck intf let (intf', intfErrs) = intfSyntaxCheck intf
mapM_ report intfErrs mapM_ report [intfErrs]
mapM_ (loadInterface (m : ctxt)) [ (q, i) | IImportDecl q i <- is ] mapM_ (loadInterface (m : ctxt)) [ (q, i) | IImportDecl q i <- is ]
addInterface m intf' addInterface m intf'
......
...@@ -32,6 +32,7 @@ import System.IO ...@@ -32,6 +32,7 @@ import System.IO
import System.Process (system) import System.Process (system)
import Curry.Base.Ident import Curry.Base.Ident
import Curry.Base.Monad
import Curry.Base.Position import Curry.Base.Position
import Curry.Base.Pretty import Curry.Base.Pretty
import Curry.ExtendedFlat.InterfaceEquivalence (eqInterface) import Curry.ExtendedFlat.InterfaceEquivalence (eqInterface)
...@@ -105,16 +106,11 @@ parseModule :: Options -> FilePath -> CYIO CS.Module ...@@ -105,16 +106,11 @@ parseModule :: Options -> FilePath -> CYIO CS.Module
parseModule opts fn = do parseModule opts fn = do
mbSrc <- liftIO $ readModule fn mbSrc <- liftIO $ readModule fn
case mbSrc of case mbSrc of
Nothing -> left [message $ text $ "Missing file: " ++ fn] Nothing -> failMessages [message $ text $ "Missing file: " ++ fn]
Just src -> do Just src -> do
case CS.unlit fn src of ul <- liftCYM $ CS.unlit fn src
Left err -> left [err] prepd <- preprocess (optPrepOpts opts) fn ul
Right ul -> do liftCYM $ CS.parseModule fn prepd
prepd <- preprocess (optPrepOpts opts) fn ul
-- parse module
case CS.parseModule fn prepd of
Left err -> left [err]
Right parsed -> right parsed
preprocess :: PrepOpts -> FilePath -> String -> CYIO String preprocess :: PrepOpts -> FilePath -> String -> CYIO String
preprocess opts fn src preprocess opts fn src
...@@ -131,7 +127,7 @@ preprocess opts fn src ...@@ -131,7 +127,7 @@ preprocess opts fn src
ExitFailure x -> return $ Left [message $ text $ ExitFailure x -> return $ Left [message $ text $
"Preprocessor exited with exit code " ++ show x] "Preprocessor exited with exit code " ++ show x]
ExitSuccess -> Right `liftM` readFile outFn ExitSuccess -> Right `liftM` readFile outFn
either left right res either failMessages ok res
withTempFile :: (FilePath -> Handle -> IO a) -> IO a withTempFile :: (FilePath -> Handle -> IO a) -> IO a
withTempFile act = do withTempFile act = do
...@@ -153,9 +149,9 @@ checkModuleId :: Monad m => FilePath -> CS.Module ...@@ -153,9 +149,9 @@ checkModuleId :: Monad m => FilePath -> CS.Module
-> CYT m CS.Module -> CYT m CS.Module
checkModuleId fn m@(CS.Module _ mid _ _ _) checkModuleId fn m@(CS.Module _ mid _ _ _)
| last (midQualifiers mid) == takeBaseName fn | last (midQualifiers mid) == takeBaseName fn
= right m = ok m
| otherwise | otherwise
= left [errModuleFileMismatch mid] = failMessages [errModuleFileMismatch mid]
-- An implicit import of the prelude is added to the declarations of -- An implicit import of the prelude is added to the declarations of
-- every module, except for the prelude itself, or when the import is disabled -- every module, except for the prelude itself, or when the import is disabled
...@@ -300,7 +296,7 @@ matchInterface :: FilePath -> CS.Interface -> IO Bool ...@@ -300,7 +296,7 @@ matchInterface :: FilePath -> CS.Interface -> IO Bool
matchInterface ifn i = do matchInterface ifn i = do
hdl <- openFile ifn ReadMode hdl <- openFile ifn ReadMode
src <- hGetContents hdl src <- hGetContents hdl
case CS.parseInterface ifn src of case runCYM (CS.parseInterface ifn src) of
Left _ -> hClose hdl >> return False Left _ -> hClose hdl >> return False
Right i' -> return (i `intfEquiv` fixInterface i') Right i' -> return (i `intfEquiv` fixInterface i')
......
...@@ -14,6 +14,8 @@ ...@@ -14,6 +14,8 @@
-} -}
module Main (main) where module Main (main) where
import Curry.Base.Monad (runCYIO)
import Base.Messages import Base.Messages
import Files.CymakePath (cymakeGreeting, cymakeVersion) import Files.CymakePath (cymakeGreeting, cymakeVersion)
import Html.CurryHtml (source2html) import Html.CurryHtml (source2html)
...@@ -33,9 +35,12 @@ cymake (prog, opts, files, errs) ...@@ -33,9 +35,12 @@ cymake (prog, opts, files, errs)
| mode == ModeNumericVersion = printNumericVersion | mode == ModeNumericVersion = printNumericVersion
| not $ null errs = badUsage prog errs | not $ null errs = badUsage prog errs
| null files = badUsage prog ["no input files"] | null files = badUsage prog ["no input files"]
| mode == ModeHtml = runEitherCYIO $ mapM_ (source2html opts) files | mode == ModeHtml =
| otherwise = runEitherCYIO $ mapM_ (buildCurry opts) files runCYIO (mapM_ (source2html opts) files) >>= okOrAbort
| otherwise =
runCYIO (mapM_ (buildCurry opts) files) >>= okOrAbort
where mode = optMode opts where mode = optMode opts
okOrAbort = either abortWithMessages return
-- |Print the usage information of the command line tool -- |Print the usage information of the command line tool
printUsage :: String -> IO () printUsage :: String -> IO ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment