module Language.Modulo.Load (
ModulePath,
relativePath,
absolutePaths,
stdModulePaths,
withStdModulePaths,
loadModule,
loadDependencies,
) where
import Control.Exception
import Language.Modulo
import Language.Modulo.Parse
import Language.Modulo.Util
import qualified Data.List.NonEmpty as NonEmpty
type ModulePath = FilePath
stdModulePaths :: [ModulePath]
stdModulePaths = ["/usr/modules", "/usr/local/modules"]
withStdModulePaths :: [ModulePath] -> [ModulePath]
withStdModulePaths = (++ stdModulePaths)
relativePath :: ModuleName -> FilePath
relativePath n = concatSep "/" (getModuleNameList n) ++ ".module"
absolutePaths :: [ModulePath] -> ModuleName -> [FilePath]
absolutePaths ps n = map (++ "/" ++ relativePath n) ps
loadDependencies :: [ModulePath] -> Module -> IO [Module]
loadDependencies ps m = do
let depNames =filterImports $ modImports m
deps <- concatMapM (loadModule ps) depNames
return $ m : deps
loadModule :: [ModulePath] -> ModuleName -> IO [Module]
loadModule ps n = do
m <- unsafeLoad ps n
let depNames = filterImports $ modImports m
deps <- concatMapM (loadModule ps) depNames
return $ m : deps
where
unsafeLoad :: [ModulePath] -> ModuleName -> IO Module
unsafeLoad ps n = do
s <- unsafeReadAny $ absolutePaths ps n
let m = unsafeParse s
if (modName m /= n)
then (error $ "File name does not match module name: \n"
++ " Saw: `" ++ show (modName m) ++ "'\n"
++ " Expected: `" ++ show n ++ "'\n")
else (return m)
unsafeParse :: String -> Module
unsafeParse s = case (parse s) of
Left e -> error $ "Parse error: " ++ show e
Right m -> m
filterImports :: [(ModuleName, Maybe String)] -> [ModuleName]
filterImports = concatMap $ \imp -> case imp of
(name, Nothing) -> [name]
(name, Just conv) -> []
unsafeReadAny :: [FilePath] -> IO String
unsafeReadAny [] = error "unsafeReadAny: Empty path list"
unsafeReadAny (f:fs) = do
r <- try $ readFile f :: IO (Either IOException String)
case r of
Left e -> if (null fs) then (error $ show e) else unsafeReadAny fs
Right s -> return s