module Nirum.Package ( Package (..) , PackageError (..) , ParseError , docs , resolveModule , scanModules , scanPackage , target ) where import System.IO.Error (catchIOError) import Control.Monad.Except ( ExceptT , MonadError (throwError) , liftIO , runExceptT ) import qualified Data.Map.Strict as M import qualified Data.Set as S import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (()) import Nirum.Constructs.Module import Nirum.Constructs.ModulePath (ModulePath, fromFilePath) import Nirum.Package.Metadata ( MetadataError , Package (Package, metadata, modules) , Target , metadataPath , packageTarget , readFromPackage ) import qualified Nirum.Package.ModuleSet as MS import Nirum.Parser (ParseError, parseFile) target :: Target t => Package t -> t target = packageTarget resolveModule :: ModulePath -> Package t -> Maybe Module resolveModule path Package { modules = ms } = MS.lookup path ms data PackageError = ScanError FilePath IOError | ParseError ModulePath ParseError | ImportError (S.Set MS.ImportError) | MetadataError MetadataError deriving (Eq, Show) -- | Scan the given package path, and then return the read package. scanPackage :: Target t => FilePath -> IO (Either PackageError (Package t)) scanPackage packagePath = runExceptT $ do metadataE <- catch (readFromPackage packagePath) (ScanError $ metadataPath packagePath) metadata' <- case metadataE of Right m -> return m Left e -> throwError $ MetadataError e modulePaths <- liftIO $ scanModules packagePath modules' <- mapM (\ p -> catch (parseFile p) $ ScanError p) modulePaths case M.foldrWithKey excludeFailedParse (Right M.empty) modules' of Right parsedModules -> case MS.fromMap parsedModules of Right ms -> return $ Package metadata' ms Left errors -> throwError $ ImportError errors Left error' -> throwError error' where excludeFailedParse :: ModulePath -> Either ParseError Module -> Either PackageError (M.Map ModulePath Module) -> Either PackageError (M.Map ModulePath Module) excludeFailedParse _ _ (Left error') = Left error' excludeFailedParse path (Left error') _ = Left $ ParseError path error' excludeFailedParse path (Right module') (Right map') = Right (M.insert path module' map') catch :: IO a -> (IOError -> e) -> ExceptT e IO a catch op onError = do result <- liftIO $ catchIOError (fmap Right op) (return . Left . onError) case result of Left err -> throwError err Right val -> return val -- | Scan the given path recursively, and then return the map of -- detected module paths. scanModules :: FilePath -> IO (M.Map ModulePath FilePath) scanModules packagePath = do files <- scanFiles "" return $ M.fromList files where isNotHidden :: FilePath -> Bool isNotHidden ('.' : _) = False isNotHidden _ = True scanFiles :: FilePath -> IO [(ModulePath, FilePath)] scanFiles path = do dir <- doesDirectoryExist realPath if dir then do subpaths <- listDirectory realPath scans <- mapM (scanFiles . (path )) $ filter isNotHidden subpaths return $ concat scans else return $ case fromFilePath path of Just modulePath' -> [(modulePath', realPath)] Nothing -> [] where realPath :: FilePath realPath = case path of [] -> packagePath p -> packagePath p