autoexporter 1.1.17 → 1.1.18

raw patch · 3 files changed

+134/−94 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• autoexporter.cabal +1/−1
• src/exe/Main.hs +3/−1
• src/lib/Autoexporter.hs +130/−92

@@ -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.

@@ -1,4 +1,6 @@+module Main ( main ) where+ import qualified Autoexporter  main :: IO ()-main = Autoexporter.defaultMain+main = Autoexporter.autoexporter

@@ -5,118 +5,156 @@ -- -- For more information, please see the README on GitHub: -- <https://github.com/tfausak/autoexporter#readme>.-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