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 :: IO ()
autoexporter = do
[String]
arguments <- IO [String]
Environment.getArgs
(String
input, String
output, Depth
depth) <- case [String]
arguments of
[String
input, String
_, String
output] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
input, String
output, Depth
DepthShallow)
[String
input, String
_, String
output, String
"--deep"] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
input, String
output, Depth
DepthDeep)
[String]
_ -> forall e a. Exception e => e -> IO a
Exception.throwIO ([String] -> InvalidArguments
InvalidArguments [String]
arguments)
ModuleName
moduleName <- case String -> Maybe ModuleName
toModuleName String
input of
Just ModuleName
moduleName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleName
moduleName
Maybe ModuleName
Nothing -> forall e a. Exception e => e -> IO a
Exception.throwIO (String -> InvalidModuleName
InvalidModuleName String
input)
[String]
entries <- Depth -> String -> IO [String]
listDirectory Depth
depth (String -> String
FilePath.dropExtension String
input)
let moduleNames :: [ModuleName]
moduleNames = [String] -> [ModuleName]
getModuleNames [String]
entries
let content :: String
content = ModuleName -> [ModuleName] -> String
renderModule ModuleName
moduleName [ModuleName]
moduleNames
String -> String -> IO ()
writeFile String
output String
content
data Depth
= DepthShallow
| DepthDeep
deriving (Depth -> Depth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Depth -> Depth -> Bool
$c/= :: Depth -> Depth -> Bool
== :: Depth -> Depth -> Bool
$c== :: Depth -> Depth -> Bool
Eq, Int -> Depth -> String -> String
[Depth] -> String -> String
Depth -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Depth] -> String -> String
$cshowList :: [Depth] -> String -> String
show :: Depth -> String
$cshow :: Depth -> String
showsPrec :: Int -> Depth -> String -> String
$cshowsPrec :: Int -> Depth -> String -> String
Show)
newtype InvalidArguments
= InvalidArguments [String]
deriving (InvalidArguments -> InvalidArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidArguments -> InvalidArguments -> Bool
$c/= :: InvalidArguments -> InvalidArguments -> Bool
== :: InvalidArguments -> InvalidArguments -> Bool
$c== :: InvalidArguments -> InvalidArguments -> Bool
Eq, Int -> InvalidArguments -> String -> String
[InvalidArguments] -> String -> String
InvalidArguments -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InvalidArguments] -> String -> String
$cshowList :: [InvalidArguments] -> String -> String
show :: InvalidArguments -> String
$cshow :: InvalidArguments -> String
showsPrec :: Int -> InvalidArguments -> String -> String
$cshowsPrec :: Int -> InvalidArguments -> String -> String
Show)
instance Exception.Exception InvalidArguments
toModuleName :: FilePath -> Maybe Cabal.ModuleName
toModuleName :: String -> Maybe ModuleName
toModuleName =
forall a. [a] -> Maybe a
Maybe.listToMaybe
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (forall a. Parsec a => String -> Maybe a
Cabal.simpleParse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
List.intercalate String
".")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
List.tails
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
FilePath.splitDirectories
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
FilePath.dropExtensions
newtype InvalidModuleName
= InvalidModuleName FilePath
deriving (InvalidModuleName -> InvalidModuleName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidModuleName -> InvalidModuleName -> Bool
$c/= :: InvalidModuleName -> InvalidModuleName -> Bool
== :: InvalidModuleName -> InvalidModuleName -> Bool
$c== :: InvalidModuleName -> InvalidModuleName -> Bool
Eq, Int -> InvalidModuleName -> String -> String
[InvalidModuleName] -> String -> String
InvalidModuleName -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InvalidModuleName] -> String -> String
$cshowList :: [InvalidModuleName] -> String -> String
show :: InvalidModuleName -> String
$cshow :: InvalidModuleName -> String
showsPrec :: Int -> InvalidModuleName -> String -> String
$cshowsPrec :: Int -> InvalidModuleName -> String -> String
Show)
instance Exception.Exception InvalidModuleName
listDirectory :: Depth -> FilePath -> IO [FilePath]
listDirectory :: Depth -> String -> IO [String]
listDirectory Depth
depth = case Depth
depth of
Depth
DepthShallow -> String -> IO [String]
listDirectoryShallow
Depth
DepthDeep -> String -> IO [String]
listDirectoryDeep
listDirectoryShallow :: FilePath -> IO [FilePath]
listDirectoryShallow :: String -> IO [String]
listDirectoryShallow String
directory = do
[String]
entries <- String -> IO [String]
Directory.listDirectory String
directory
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
FilePath.combine String
directory) [String]
entries)
listDirectoryDeep :: FilePath -> IO [FilePath]
listDirectoryDeep :: String -> IO [String]
listDirectoryDeep String
directory = do
[String]
entries <- String -> IO [String]
listDirectoryShallow String
directory
let listEntry :: String -> IO [String]
listEntry String
entry = do
Bool
isDirectory <- String -> IO Bool
Directory.doesDirectoryExist String
entry
if Bool
isDirectory then String -> IO [String]
listDirectoryDeep String
entry else forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
entry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
listEntry [String]
entries)
getModuleNames :: [FilePath] -> [Cabal.ModuleName]
getModuleNames :: [String] -> [ModuleName]
getModuleNames =
forall a. Ord a => [a] -> [a]
List.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe String -> Maybe ModuleName
toModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isHaskellFile
isHaskellFile :: FilePath -> Bool
isHaskellFile :: String -> Bool
isHaskellFile = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String]
haskellExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
FilePath.takeExtensions
haskellExtensions :: [String]
haskellExtensions :: [String]
haskellExtensions = [String
".hs", String
".lhs"]
renderModule :: Cabal.ModuleName -> [Cabal.ModuleName] -> String
renderModule :: ModuleName -> [ModuleName] -> String
renderModule ModuleName
moduleName [ModuleName]
moduleNames =
[String] -> String
unlines
[ String
"{-# OPTIONS_GHC -fno-warn-dodgy-exports -fno-warn-unused-imports #-}",
String
"module " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> String
Cabal.display ModuleName
moduleName forall a. Semigroup a => a -> a -> a
<> String
" (",
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> String
renderExport [ModuleName]
moduleNames),
String
") where",
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> String
renderImport [ModuleName]
moduleNames)
]
renderExport :: Cabal.ModuleName -> String
renderExport :: ModuleName -> String
renderExport ModuleName
moduleName = String
"module " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> String
Cabal.display ModuleName
moduleName forall a. Semigroup a => a -> a -> a
<> String
","
renderImport :: Cabal.ModuleName -> String
renderImport :: ModuleName -> String
renderImport ModuleName
moduleName = String
"import " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> String
Cabal.display ModuleName
moduleName