module Autoexporter ( autoexporter ) where
import qualified Control.Exception as Exception
import qualified Data.List as List
import qualified Data.Maybe as Maybe
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
autoexporter :: IO ()
autoexporter = do
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)
moduleName <- case toModuleName input of
Just moduleName -> pure moduleName
Nothing -> Exception.throwIO (InvalidModuleName input)
entries <- listDirectory depth (FilePath.dropExtension input)
let moduleNames = getModuleNames entries
let content = renderModule moduleName moduleNames
writeFile output content
data Depth
= DepthShallow
| DepthDeep
deriving (Eq, Show)
newtype InvalidArguments
= InvalidArguments [String]
deriving (Eq, Show)
instance Exception.Exception InvalidArguments
toModuleName :: FilePath -> Maybe Cabal.ModuleName
toModuleName
= Maybe.listToMaybe
. Maybe.mapMaybe Cabal.simpleParse
. fmap (List.intercalate ".")
. List.tails
. FilePath.splitDirectories
. FilePath.dropExtensions
newtype InvalidModuleName
= InvalidModuleName FilePath
deriving (Eq, Show)
instance Exception.Exception InvalidModuleName
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)
getModuleNames :: [FilePath] -> [Cabal.ModuleName]
getModuleNames = List.sort . Maybe.mapMaybe toModuleName . filter isHaskellFile
isHaskellFile :: FilePath -> Bool
isHaskellFile = flip elem haskellExtensions . FilePath.takeExtensions
haskellExtensions :: [String]
haskellExtensions = [".hs", ".lhs"]
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