module System.Imports where
import System.Directory
import System.FilePath
import System.IO
import Control.Monad
import Control.Monad.Writer
import Control.Monad.Except
import Data.Monoid
import Data.Either
type Predictor
= FilePath
-> IO Bool
defaultPred :: Predictor
defaultPred path =
case takeFileName path of
"" -> return False
('.':_) -> return False
('_':_) -> return False
filename -> liftM isLeft . runExceptT $ do
lift (doesDirectoryExist path) >>= flip when (throwError ())
let ext = takeExtension filename
when (ext == ".hs" || ext == ".lhs") (throwError ())
return ()
pathToModule :: FilePath -> String
pathToModule path = go $ dropExtensions path where
go [] = []
go (a:as)
| isPathSeparator a = '.' : go as
| otherwise = a : go as
searchImportsWith
:: Predictor
-> FilePath
-> IO [String]
searchImportsWith p rootPath = go "" where
go subPath = execWriterT $ do
let thisPath = rootPath </> subPath
entries <- lift $ getDirectoryContents thisPath
forM_ entries $ \entry -> do
let entryPath = thisPath </> entry
let subPath' = subPath </> entry
toDo <- lift . liftM isRight . runExceptT $ do
when (entry == "" || entry == "." || entry == "..") (throwError ())
flip unless (throwError ()) =<< lift (p entryPath)
return ()
when toDo $ do
(lift (doesDirectoryExist entryPath) >>=) . flip when $ do
tell =<< lift (go subPath')
(lift (doesFileExist entryPath) >>=) . flip when $ do
tell [pathToModule subPath']
searchImports
:: FilePath
-> IO [String]
searchImports = searchImportsWith defaultPred
importsContentWith
:: Predictor
-> String
-> [(String, FilePath)]
-> IO String
importsContentWith p alias sources = execWriterT $ do
forM_ sources $ \(prefix', root) -> do
let prefix = if null prefix' then "" else prefix' ++ "."
imports <- lift $ searchImportsWith p root
forM_ imports $ \im -> do
tell $ "import " ++ prefix ++ im ++ " as " ++ alias ++ "\n"
importsContent
:: String
-> [(String, FilePath)]
-> IO String
importsContent = importsContentWith defaultPred
writeMultiImportsHeaderWith
:: Predictor
-> FilePath
-> String
-> [(String, FilePath)]
-> IO ()
writeMultiImportsHeaderWith p headerPath alias sources = do
headerContent <- importsContentWith p alias sources
writeFile headerPath headerContent
writeMultiImportsHeader
:: FilePath
-> String
-> [(String, FilePath)]
-> IO ()
writeMultiImportsHeader = writeMultiImportsHeaderWith defaultPred
writeImportsHeaderWith
:: Predictor
-> FilePath
-> String
-> String
-> FilePath
-> IO ()
writeImportsHeaderWith p headerPath alias prefix rootPath = writeMultiImportsHeaderWith p headerPath alias [(prefix, rootPath)]
writeImportsHeader
:: FilePath
-> String
-> String
-> FilePath
-> IO ()
writeImportsHeader = writeImportsHeaderWith defaultPred
writeMultiImportsModuleWith
:: Predictor
-> FilePath
-> String
-> [(String, FilePath)]
-> IO ()
writeMultiImportsModuleWith p modulePath moduleName sources = do
headerContent <- importsContentWith p "Export" sources
writeFile modulePath $ "module " ++ moduleName ++ " (module Export) where\n" ++ headerContent
writeMultiImportsModule
:: FilePath
-> String
-> [(String, FilePath)]
-> IO ()
writeMultiImportsModule = writeMultiImportsModuleWith defaultPred
writeImportsModuleWith
:: Predictor
-> FilePath
-> String
-> String
-> FilePath
-> IO ()
writeImportsModuleWith p modulePath moduleName prefix rootPath =
writeMultiImportsModuleWith p modulePath moduleName [(prefix, rootPath)]
writeImportsModule
:: FilePath
-> String
-> String
-> FilePath
-> IO ()
writeImportsModule = writeImportsModuleWith defaultPred