diff --git a/autoexporter.cabal b/autoexporter.cabal --- a/autoexporter.cabal +++ b/autoexporter.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: autoexporter -version: 1.1.17 +version: 1.1.18 synopsis: Automatically re-export modules. description: Autoexporter automatically re-exports modules. diff --git a/src/exe/Main.hs b/src/exe/Main.hs --- a/src/exe/Main.hs +++ b/src/exe/Main.hs @@ -1,4 +1,6 @@ +module Main ( main ) where + import qualified Autoexporter main :: IO () -main = Autoexporter.defaultMain +main = Autoexporter.autoexporter diff --git a/src/lib/Autoexporter.hs b/src/lib/Autoexporter.hs --- a/src/lib/Autoexporter.hs +++ b/src/lib/Autoexporter.hs @@ -5,118 +5,156 @@ -- -- For more information, please see the README on GitHub: -- . -module Autoexporter - ( defaultMain - , mainWithArgs - , autoexport - , findFiles - , findFilesDeep - , makeModuleName - , takeWhileEnd - , isModuleName - , parseModuleName - , makeOutput - , isHaskellFile - , renderModule - , unlines' - , renderExport - , renderImport - ) where +module Autoexporter ( autoexporter ) where +import qualified Control.Exception as Exception import qualified Data.List as List import qualified Data.Maybe as Maybe -import qualified Data.Traversable as Traversable -import qualified Distribution.ModuleName as ModuleName -import qualified Distribution.Text as Text +import qualified Distribution.ModuleName as Cabal +import qualified Distribution.Text as Cabal import qualified System.Directory as Directory import qualified System.Environment as Environment import qualified System.FilePath as FilePath -data ExportScope = ExportScopeShallow - | ExportScopeDeep -defaultMain :: IO () -defaultMain = do - args <- Environment.getArgs - mainWithArgs args +autoexporter :: IO () +autoexporter = do + -- Start by getting the command line arguments. We expect three positional + -- arguments from GHC: the path to the original source file, the path to the + -- actual input file, and the path to the output file. The source and input + -- files could be different if another preprocessor is involved. Since we + -- don't consider the file's contents, we can ignore the input file. + -- + -- After GHC's arguments, we have to check for anything passed in by the user + -- with @-optF@. + arguments <- Environment.getArgs + (input, output, depth) <- case arguments of + [input, _, output] -> pure (input, output, DepthShallow) + [input, _, output, "--deep"] -> pure (input, output, DepthDeep) + _ -> Exception.throwIO (InvalidArguments arguments) -mainWithArgs :: [String] -> IO () -mainWithArgs args = - case args of - [name, inputFile, outputFile, "--deep"] -> - autoexport ExportScopeDeep name inputFile outputFile - [name, inputFile, outputFile] -> - autoexport ExportScopeShallow name inputFile outputFile - _ -> fail ("unexpected arguments: " ++ show args) + -- Next we convert the original source file path into a module name. If we + -- aren't able to do this then something weird is going on and we should + -- crash. + moduleName <- case toModuleName input of + Just moduleName -> pure moduleName + Nothing -> Exception.throwIO (InvalidModuleName input) -autoexport :: ExportScope -> String -> FilePath -> FilePath -> IO () -autoexport exportScope name inputFile outputFile = do - let moduleName = makeModuleName name - let directory = FilePath.dropExtension inputFile - files <- findFiles exportScope directory - let output = makeOutput moduleName directory files - writeFile outputFile output + -- Then we want to find all of the relevant modules to re-export. Note that + -- we simply ignore non-Haskell files and files that don't form valid module + -- names. Also we sort the module names so that the output is deterministic. + entries <- listDirectory depth (FilePath.dropExtension input) + let moduleNames = getModuleNames entries -findFiles :: ExportScope -> FilePath -> IO [FilePath] -findFiles exportScope dir = - case exportScope of - ExportScopeShallow -> - fmap (filter isHaskellFile) (Directory.listDirectory dir) - ExportScopeDeep -> - findFilesDeep dir + -- Finally we render the module and write it to the output file. + let content = renderModule moduleName moduleNames + writeFile output content -findFilesDeep :: FilePath -> IO [FilePath] -findFilesDeep dir = do - rootItems <- Directory.listDirectory dir - childItems <- Traversable.for rootItems $ \item -> do - let path = dir FilePath. item - dirExists <- Directory.doesDirectoryExist path - if dirExists - then fmap (fmap (item FilePath.)) (findFilesDeep path) - else pure [] - pure $ mconcat (filter isHaskellFile rootItems : childItems) -makeModuleName :: FilePath -> String -makeModuleName name = - let path = FilePath.dropExtension name - parts = FilePath.splitDirectories path - rest = takeWhileEnd isModuleName parts - in List.intercalate "." rest +-- | This type describes how to search for modules to export. A shallow search +-- only considers files in one directory. A deep search considers all files in +-- the directory tree. +data Depth + = DepthShallow + | DepthDeep + deriving (Eq, Show) -takeWhileEnd :: (a -> Bool) -> [a] -> [a] -takeWhileEnd p xs = reverse (takeWhile p (reverse xs)) -isModuleName :: String -> Bool -isModuleName x = Maybe.isJust (parseModuleName x) +-- | This exception type is thrown when we don't know how to interpret the +-- arguments passed to the program. +newtype InvalidArguments + = InvalidArguments [String] + deriving (Eq, Show) -parseModuleName :: String -> Maybe ModuleName.ModuleName -parseModuleName = Text.simpleParse +instance Exception.Exception InvalidArguments -makeOutput :: String -> FilePath -> [FilePath] -> String -makeOutput moduleName directory files = - let haskellFiles = filter isHaskellFile files - paths = map (directory FilePath.) haskellFiles - modules = List.sort (map makeModuleName paths) - in renderModule moduleName modules +-- | This function attempts to convert an arbitrary file path into a valid +-- Haskell module name. Any extensions are ignored. +-- +-- >>> toModuleName "invalid/module.name" +-- Nothing +-- >>> toModuleName "valid/Module.name" +-- Just (ModuleName ["Module"]) +-- >>> toModuleName "Qualified/Module.name" +-- Just (ModuleName ["Qualified","Module"]) +toModuleName :: FilePath -> Maybe Cabal.ModuleName +toModuleName + = Maybe.listToMaybe + . Maybe.mapMaybe Cabal.simpleParse + . fmap (List.intercalate ".") + . List.tails + . FilePath.splitDirectories + . FilePath.dropExtensions + + +-- | This exception type is thrown when we can't create a valid module name +-- from the source file path. +newtype InvalidModuleName + = InvalidModuleName FilePath + deriving (Eq, Show) + +instance Exception.Exception InvalidModuleName + + +-- | Lists all of the entries in the given directory. Note that unlike +-- 'Directory.listDirectory' the results of calling this function will include +-- the original directory name. +listDirectory :: Depth -> FilePath -> IO [FilePath] +listDirectory depth = case depth of + DepthShallow -> listDirectoryShallow + DepthDeep -> listDirectoryDeep + + +listDirectoryShallow :: FilePath -> IO [FilePath] +listDirectoryShallow directory = do + entries <- Directory.listDirectory directory + pure (fmap (FilePath.combine directory) entries) + + +listDirectoryDeep :: FilePath -> IO [FilePath] +listDirectoryDeep directory = do + entries <- listDirectoryShallow directory + let + listEntry entry = do + isDirectory <- Directory.doesDirectoryExist entry + if isDirectory + then listDirectoryDeep entry + else pure [entry] + fmap concat (mapM listEntry entries) + + +-- | Given a list of file paths, returns a sorted list of module names from the +-- entries that were Haskell files. +getModuleNames :: [FilePath] -> [Cabal.ModuleName] +getModuleNames = List.sort . Maybe.mapMaybe toModuleName . filter isHaskellFile + + +-- | This predicate tells you if the given file path is a Haskell source file. isHaskellFile :: FilePath -> Bool -isHaskellFile x = List.isSuffixOf ".hs" x || List.isSuffixOf ".lhs" x +isHaskellFile = flip elem haskellExtensions . FilePath.takeExtensions -renderModule :: String -> [String] -> String -renderModule name modules = - unlines' - [ "{-# OPTIONS_GHC -fno-warn-dodgy-exports -fno-warn-unused-imports #-}" - , unwords ["module", name, "("] - , unlines' (map renderExport modules) - , ") where" - , unlines' (map renderImport modules) - ] -unlines' :: [String] -> String -unlines' = List.intercalate "\n" +-- | These are the extensions that we consider to be Haskell source files. +haskellExtensions :: [String] +haskellExtensions = [".hs", ".lhs"] -renderExport :: String -> String -renderExport x = " module " ++ x ++ "," -renderImport :: String -> String -renderImport x = "import " ++ x +-- | Given a module name and a list of module names to re-export, renders a +-- module with all the appropriate imports and exports. +renderModule :: Cabal.ModuleName -> [Cabal.ModuleName] -> String +renderModule moduleName moduleNames = unlines + [ "{-# OPTIONS_GHC -fno-warn-dodgy-exports -fno-warn-unused-imports #-}" + , "module " <> Cabal.display moduleName <> " (" + , List.intercalate "\n" (fmap renderExport moduleNames) + , ") where" + , List.intercalate "\n" (fmap renderImport moduleNames) + ] + + +renderExport :: Cabal.ModuleName -> String +renderExport moduleName = "module " <> Cabal.display moduleName <> "," + + +renderImport :: Cabal.ModuleName -> String +renderImport moduleName = "import " <> Cabal.display moduleName