module Data.GI.CodeGen.Code
( Code(..)
, ModuleInfo(..)
, ModuleFlag(..)
, BaseCodeGen
, CodeGen
, ExcCodeGen
, CGError(..)
, genCode
, evalCodeGen
, writeModuleTree
, listModuleTree
, codeToText
, transitiveModuleDeps
, minBaseVersion
, BaseVersion(..)
, showBaseVersion
, registerNSDependency
, qualified
, getDeps
, recurseWithAPIs
, handleCGExc
, describeCGError
, notImplementedError
, badIntroError
, missingInfoError
, indent
, bline
, line
, blank
, group
, hsBoot
, submodule
, setLanguagePragmas
, setGHCOptions
, setModuleFlags
, setModuleMinBase
, exportToplevel
, exportModule
, exportDecl
, exportMethod
, exportProperty
, exportSignal
, findAPI
, getAPI
, findAPIByName
, getAPIs
, getC2HMap
, config
, currentModule
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
import Data.Monoid (Monoid(..))
#endif
import Control.Monad.Reader
import Control.Monad.State.Strict
import Control.Monad.Except
import qualified Data.Foldable as F
import Data.Maybe (fromMaybe, catMaybes)
import Data.Monoid ((<>))
import Data.Sequence (Seq, ViewL ((:<)), (><), (|>), (<|))
import qualified Data.Map.Strict as M
import qualified Data.Sequence as S
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import System.Directory (createDirectoryIfMissing)
import System.FilePath (joinPath, takeDirectory)
import Data.GI.CodeGen.API (API, Name(..))
import Data.GI.CodeGen.Config (Config(..))
import Data.GI.CodeGen.CtoHaskellMap (cToHaskellMap,
Hyperlink)
import Data.GI.CodeGen.GtkDoc (CRef)
import Data.GI.CodeGen.ModulePath (ModulePath(..), dotModulePath, (/.))
import Data.GI.CodeGen.Type (Type(..))
import Data.GI.CodeGen.Util (tshow, terror, padTo, utf8WriteFile)
import Data.GI.CodeGen.ProjectInfo (authors, license, maintainers)
data Code
= NoCode
| Line Text
| Indent Code
| Sequence (Seq Code)
| Group Code
deriving (Eq, Show)
instance Monoid Code where
mempty = NoCode
NoCode `mappend` NoCode = NoCode
x `mappend` NoCode = x
NoCode `mappend` x = x
(Sequence a) `mappend` (Sequence b) = Sequence (a >< b)
(Sequence a) `mappend` b = Sequence (a |> b)
a `mappend` (Sequence b) = Sequence (a <| b)
a `mappend` b = Sequence (a <| b <| S.empty)
type Deps = Set.Set Text
type HaddockSection = Text
type SymbolName = Text
data Export = Export {
exportType :: ExportType
, exportSymbol :: SymbolName
} deriving (Show, Eq, Ord)
data ExportType = ExportTypeDecl
| ExportToplevel
| ExportMethod HaddockSection
| ExportProperty HaddockSection
| ExportSignal HaddockSection
| ExportModule
deriving (Show, Eq, Ord)
data ModuleInfo = ModuleInfo {
modulePath :: ModulePath
, moduleCode :: Code
, bootCode :: Code
, submodules :: M.Map Text ModuleInfo
, moduleDeps :: Deps
, moduleExports :: Seq Export
, qualifiedImports :: Set.Set ModulePath
, modulePragmas :: Set.Set Text
, moduleGHCOpts :: Set.Set Text
, moduleFlags :: Set.Set ModuleFlag
, moduleDoc :: Maybe Text
, moduleMinBase :: BaseVersion
}
data ModuleFlag = ImplicitPrelude
deriving (Show, Eq, Ord)
data BaseVersion = Base47
| Base48
deriving (Show, Eq, Ord)
showBaseVersion :: BaseVersion -> Text
showBaseVersion Base47 = "4.7"
showBaseVersion Base48 = "4.8"
emptyModule :: ModulePath -> ModuleInfo
emptyModule m = ModuleInfo { modulePath = m
, moduleCode = NoCode
, bootCode = NoCode
, submodules = M.empty
, moduleDeps = Set.empty
, moduleExports = S.empty
, qualifiedImports = Set.empty
, modulePragmas = Set.empty
, moduleGHCOpts = Set.empty
, moduleFlags = Set.empty
, moduleDoc = Nothing
, moduleMinBase = Base47
}
data CodeGenConfig = CodeGenConfig {
hConfig :: Config
, loadedAPIs :: M.Map Name API
, c2hMap :: M.Map CRef Hyperlink
}
data CGError = CGErrorNotImplemented Text
| CGErrorBadIntrospectionInfo Text
| CGErrorMissingInfo Text
deriving (Show)
type BaseCodeGen excType a =
ReaderT CodeGenConfig (StateT ModuleInfo (ExceptT excType IO)) a
type CodeGen a = forall e. BaseCodeGen e a
type ExcCodeGen a = BaseCodeGen CGError a
runCodeGen :: BaseCodeGen e a -> CodeGenConfig -> ModuleInfo ->
IO (Either e (a, ModuleInfo))
runCodeGen cg cfg state = runExceptT (runStateT (runReaderT cg cfg) state)
cleanInfo :: ModuleInfo -> ModuleInfo
cleanInfo info = info { moduleCode = NoCode, submodules = M.empty,
bootCode = NoCode, moduleExports = S.empty,
qualifiedImports = Set.empty,
moduleDoc = Nothing, moduleMinBase = Base47 }
recurseCG :: BaseCodeGen e a -> BaseCodeGen e (a, Code)
recurseCG cg = do
cfg <- ask
oldInfo <- get
let info = cleanInfo oldInfo
liftIO (runCodeGen cg cfg info) >>= \case
Left e -> throwError e
Right (r, new) -> put (mergeInfoState oldInfo new) >>
return (r, moduleCode new)
recurseWithAPIs :: M.Map Name API -> CodeGen () -> CodeGen ()
recurseWithAPIs apis cg = do
cfg <- ask
oldInfo <- get
let info = cleanInfo oldInfo
cfg' = cfg {loadedAPIs = apis,
c2hMap = cToHaskellMap (M.toList apis)}
liftIO (runCodeGen cg cfg' info) >>= \case
Left e -> throwError e
Right (_, new) -> put (mergeInfo oldInfo new)
mergeInfoState :: ModuleInfo -> ModuleInfo -> ModuleInfo
mergeInfoState oldState newState =
let newDeps = Set.union (moduleDeps oldState) (moduleDeps newState)
newSubmodules = M.unionWith mergeInfo (submodules oldState) (submodules newState)
newExports = moduleExports oldState <> moduleExports newState
newImports = qualifiedImports oldState <> qualifiedImports newState
newPragmas = Set.union (modulePragmas oldState) (modulePragmas newState)
newGHCOpts = Set.union (moduleGHCOpts oldState) (moduleGHCOpts newState)
newFlags = Set.union (moduleFlags oldState) (moduleFlags newState)
newBoot = bootCode oldState <> bootCode newState
newDoc = moduleDoc oldState <> moduleDoc newState
newMinBase = max (moduleMinBase oldState) (moduleMinBase newState)
in oldState {moduleDeps = newDeps, submodules = newSubmodules,
moduleExports = newExports, qualifiedImports = newImports,
modulePragmas = newPragmas,
moduleGHCOpts = newGHCOpts, moduleFlags = newFlags,
bootCode = newBoot, moduleDoc = newDoc,
moduleMinBase = newMinBase }
mergeInfo :: ModuleInfo -> ModuleInfo -> ModuleInfo
mergeInfo oldInfo newInfo =
let info = mergeInfoState oldInfo newInfo
in info { moduleCode = moduleCode oldInfo <> moduleCode newInfo }
addSubmodule :: Text -> ModuleInfo -> ModuleInfo -> ModuleInfo
addSubmodule modName submodule current = current { submodules = M.insertWith mergeInfo modName submodule (submodules current)}
submodule' :: Text -> BaseCodeGen e () -> BaseCodeGen e ()
submodule' modName cg = do
cfg <- ask
oldInfo <- get
let info = emptyModule (modulePath oldInfo /. modName)
liftIO (runCodeGen cg cfg info) >>= \case
Left e -> throwError e
Right (_, smInfo) -> if moduleCode smInfo == NoCode &&
M.null (submodules smInfo)
then return ()
else modify' (addSubmodule modName smInfo)
submodule :: ModulePath -> BaseCodeGen e () -> BaseCodeGen e ()
submodule (ModulePath []) cg = cg
submodule (ModulePath (m:ms)) cg = submodule' m (submodule (ModulePath ms) cg)
handleCGExc :: (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc fallback
action = do
cfg <- ask
oldInfo <- get
let info = cleanInfo oldInfo
liftIO (runCodeGen action cfg info) >>= \case
Left e -> fallback e
Right (r, newInfo) -> do
put (mergeInfo oldInfo newInfo)
return r
getDeps :: CodeGen Deps
getDeps = moduleDeps <$> get
config :: CodeGen Config
config = hConfig <$> ask
currentModule :: CodeGen Text
currentModule = do
s <- get
return (dotWithPrefix (modulePath s))
getAPIs :: CodeGen (M.Map Name API)
getAPIs = loadedAPIs <$> ask
getC2HMap :: CodeGen (M.Map CRef Hyperlink)
getC2HMap = c2hMap <$> ask
unwrapCodeGen :: CodeGen a -> CodeGenConfig -> ModuleInfo ->
IO (a, ModuleInfo)
unwrapCodeGen cg cfg info =
runCodeGen cg cfg info >>= \case
Left _ -> error "unwrapCodeGen:: The impossible happened!"
Right (r, newInfo) -> return (r, newInfo)
genCode :: Config -> M.Map Name API ->
ModulePath -> CodeGen () -> IO ModuleInfo
genCode cfg apis mPath cg = snd <$> evalCodeGen cfg apis mPath cg
evalCodeGen :: Config -> M.Map Name API ->
ModulePath -> CodeGen a -> IO (a, ModuleInfo)
evalCodeGen cfg apis mPath cg = do
let initialInfo = emptyModule mPath
cfg' = CodeGenConfig {hConfig = cfg, loadedAPIs = apis,
c2hMap = cToHaskellMap (M.toList apis)}
unwrapCodeGen cg cfg' initialInfo
registerNSDependency :: Text -> CodeGen ()
registerNSDependency name = do
deps <- getDeps
unless (Set.member name deps) $ do
let newDeps = Set.insert name deps
modify' $ \s -> s {moduleDeps = newDeps}
transitiveModuleDeps :: ModuleInfo -> Deps
transitiveModuleDeps minfo =
Set.unions (moduleDeps minfo
: map transitiveModuleDeps (M.elems $ submodules minfo))
qualified :: ModulePath -> Name -> CodeGen Text
qualified mp (Name ns s) = do
cfg <- config
when (modName cfg /= ns) $
registerNSDependency ns
minfo <- get
if mp == modulePath minfo
then return s
else do
qm <- qualifiedImport mp
return (qm <> "." <> s)
qualifiedImport :: ModulePath -> CodeGen Text
qualifiedImport mp = do
modify' $ \s -> s {qualifiedImports = Set.insert mp (qualifiedImports s)}
return (qualifiedModuleName mp)
qualifiedModuleName :: ModulePath -> Text
qualifiedModuleName (ModulePath [ns, "Objects", o]) = ns <> "." <> o
qualifiedModuleName (ModulePath [ns, "Interfaces", i]) = ns <> "." <> i
qualifiedModuleName (ModulePath [ns, "Structs", s]) = ns <> "." <> s
qualifiedModuleName (ModulePath [ns, "Unions", u]) = ns <> "." <> u
qualifiedModuleName mp = dotModulePath mp
minBaseVersion :: ModuleInfo -> BaseVersion
minBaseVersion minfo =
maximum (moduleMinBase minfo
: map minBaseVersion (M.elems $ submodules minfo))
describeCGError :: CGError -> Text
describeCGError (CGErrorNotImplemented e) = "Not implemented: " <> tshow e
describeCGError (CGErrorBadIntrospectionInfo e) = "Bad introspection data: " <> tshow e
describeCGError (CGErrorMissingInfo e) = "Missing info: " <> tshow e
notImplementedError :: Text -> ExcCodeGen a
notImplementedError s = throwError $ CGErrorNotImplemented s
badIntroError :: Text -> ExcCodeGen a
badIntroError s = throwError $ CGErrorBadIntrospectionInfo s
missingInfoError :: Text -> ExcCodeGen a
missingInfoError s = throwError $ CGErrorMissingInfo s
findAPI :: Type -> CodeGen (Maybe API)
findAPI TError = Just <$> findAPIByName (Name "GLib" "Error")
findAPI (TInterface n) = Just <$> findAPIByName n
findAPI _ = return Nothing
getAPI :: Type -> CodeGen API
getAPI t = findAPI t >>= \case
Just a -> return a
Nothing -> terror ("Could not resolve type \"" <> tshow t <> "\".")
findAPIByName :: Name -> CodeGen API
findAPIByName n@(Name ns _) = do
apis <- getAPIs
case M.lookup n apis of
Just api -> return api
Nothing ->
terror $ "couldn't find API description for " <> ns <> "." <> name n
tellCode :: Code -> CodeGen ()
tellCode c = modify' (\s -> s {moduleCode = moduleCode s <> c})
line :: Text -> CodeGen ()
line = tellCode . Line
bline :: Text -> CodeGen ()
bline l = hsBoot (line l) >> line l
blank :: CodeGen ()
blank = line ""
indent :: BaseCodeGen e a -> BaseCodeGen e a
indent cg = do
(x, code) <- recurseCG cg
tellCode (Indent code)
return x
group :: BaseCodeGen e a -> BaseCodeGen e a
group cg = do
(x, code) <- recurseCG cg
tellCode (Group code)
blank
return x
hsBoot :: BaseCodeGen e a -> BaseCodeGen e a
hsBoot cg = do
(x, code) <- recurseCG cg
modify' (\s -> s{bootCode = bootCode s <> code})
return x
export :: Export -> CodeGen ()
export e =
modify' $ \s -> s{moduleExports = moduleExports s |> e}
exportModule :: SymbolName -> CodeGen ()
exportModule m = export (Export ExportModule m)
exportToplevel :: SymbolName -> CodeGen ()
exportToplevel t = export (Export ExportToplevel t)
exportDecl :: SymbolName -> CodeGen ()
exportDecl d = export (Export ExportTypeDecl d)
exportMethod :: HaddockSection -> SymbolName -> CodeGen ()
exportMethod s n = export (Export (ExportMethod s) n)
exportProperty :: HaddockSection -> SymbolName -> CodeGen ()
exportProperty s n = export (Export (ExportProperty s) n)
exportSignal :: HaddockSection -> SymbolName -> CodeGen ()
exportSignal s n = export (Export (ExportSignal s) n)
setLanguagePragmas :: [Text] -> CodeGen ()
setLanguagePragmas ps =
modify' $ \s -> s{modulePragmas = Set.fromList ps}
setGHCOptions :: [Text] -> CodeGen ()
setGHCOptions opts =
modify' $ \s -> s{moduleGHCOpts = Set.fromList opts}
setModuleFlags :: [ModuleFlag] -> CodeGen ()
setModuleFlags flags =
modify' $ \s -> s{moduleFlags = Set.fromList flags}
setModuleMinBase :: BaseVersion -> CodeGen ()
setModuleMinBase v =
modify' $ \s -> s{moduleMinBase = max v (moduleMinBase s)}
codeToText :: Code -> Text
codeToText c = T.concat $ str 0 c []
where
str :: Int -> Code -> [Text] -> [Text]
str _ NoCode cont = cont
str n (Line s) cont = paddedLine n s : cont
str n (Indent c) cont = str (n + 1) c cont
str n (Sequence s) cont = deseq n (S.viewl s) cont
str n (Group c) cont = str n c cont
deseq _ S.EmptyL cont = cont
deseq n (c :< cs) cont = str n c (deseq n (S.viewl cs) cont)
paddedLine :: Int -> Text -> Text
paddedLine n s = T.replicate (n * 4) " " <> s <> "\n"
comma :: Text -> Text
comma s = padTo 40 s <> ","
formatExportedModules :: [Export] -> Maybe Text
formatExportedModules [] = Nothing
formatExportedModules exports =
Just . T.concat . map ( paddedLine 1
. comma
. ("module " <>)
. exportSymbol)
. filter ((== ExportModule) . exportType) $ exports
formatToplevel :: [Export] -> Maybe Text
formatToplevel [] = Nothing
formatToplevel exports =
Just . T.concat . map (paddedLine 1 . comma . exportSymbol)
. filter ((== ExportToplevel) . exportType) $ exports
formatTypeDecls :: [Export] -> Maybe Text
formatTypeDecls exports =
let exportedTypes = filter ((== ExportTypeDecl) . exportType) exports
in if exportedTypes == []
then Nothing
else Just . T.unlines $ [ "-- * Exported types"
, T.concat . map ( paddedLine 1
. comma
. exportSymbol )
$ exportedTypes ]
data Subsection = Subsection { subsectionTitle :: Text
, subsectionAnchor :: Maybe Text
} deriving (Eq, Show, Ord)
subsecWithPrefix prefix title =
Subsection { subsectionTitle = title
, subsectionAnchor = Just (prefix <> ":" <> title) }
formatSection :: Text -> (Export -> Maybe (Subsection, SymbolName)) ->
[Export] -> Maybe Text
formatSection section filter exports =
if M.null exportedSubsections
then Nothing
else Just . T.unlines $ [" -- * " <> section
, ( T.unlines
. map formatSubsection
. M.toList ) exportedSubsections]
where
filteredExports :: [(Subsection, SymbolName)]
filteredExports = catMaybes (map filter exports)
exportedSubsections :: M.Map Subsection (Set.Set SymbolName)
exportedSubsections = foldr extract M.empty filteredExports
extract :: (Subsection, SymbolName) -> M.Map Subsection (Set.Set Text)
-> M.Map Subsection (Set.Set Text)
extract (subsec, m) secs =
M.insertWith Set.union subsec (Set.singleton m) secs
formatSubsection :: (Subsection, Set.Set SymbolName) -> Text
formatSubsection (subsec, symbols) =
T.unlines [ "-- ** " <> case subsectionAnchor subsec of
Just anchor -> subsectionTitle subsec <>
" #" <> anchor <> "#"
Nothing -> subsectionTitle subsec
, ( T.concat
. map (paddedLine 1 . comma)
. Set.toList ) symbols]
formatMethods :: [Export] -> Maybe Text
formatMethods = formatSection "Methods" toMethod
where toMethod :: Export -> Maybe (Subsection, SymbolName)
toMethod (Export (ExportMethod s) m) =
Just (subsecWithPrefix "method" s, m)
toMethod _ = Nothing
formatProperties :: [Export] -> Maybe Text
formatProperties = formatSection "Properties" toProperty
where toProperty :: Export -> Maybe (Subsection, SymbolName)
toProperty (Export (ExportProperty s) m) =
Just (subsecWithPrefix "attr" s, m)
toProperty _ = Nothing
formatSignals :: [Export] -> Maybe Text
formatSignals = formatSection "Signals" toSignal
where toSignal :: Export -> Maybe (Subsection, SymbolName)
toSignal (Export (ExportSignal s) m) =
Just (subsecWithPrefix "signal" s, m)
toSignal _ = Nothing
formatExportList :: [Export] -> Text
formatExportList exports =
T.unlines . catMaybes $ [ formatExportedModules exports
, formatToplevel exports
, formatTypeDecls exports
, formatMethods exports
, formatProperties exports
, formatSignals exports ]
languagePragmas :: [Text] -> Text
languagePragmas [] = ""
languagePragmas ps = "{-# LANGUAGE " <> T.intercalate ", " ps <> " #-}\n"
ghcOptions :: [Text] -> Text
ghcOptions [] = ""
ghcOptions opts = "{-# OPTIONS_GHC " <> T.intercalate ", " opts <> " #-}\n"
standardFields :: Text
standardFields = T.unlines [ "Copyright : " <> authors
, "License : " <> license
, "Maintainer : " <> maintainers ]
moduleHaddock :: Maybe Text -> Text
moduleHaddock Nothing = T.unlines ["{- |", standardFields <> "-}"]
moduleHaddock (Just description) = T.unlines ["{- |", standardFields,
description, "-}"]
modulePrelude :: Text -> [Export] -> [Text] -> Text
modulePrelude name [] [] = "module " <> name <> " () where\n"
modulePrelude name exports [] =
"module " <> name <> "\n ( "
<> formatExportList exports
<> " ) where\n"
modulePrelude name [] reexportedModules =
"module " <> name <> "\n ( "
<> formatExportList (map (Export ExportModule) reexportedModules)
<> " ) where\n\n"
<> T.unlines (map ("import " <>) reexportedModules)
modulePrelude name exports reexportedModules =
"module " <> name <> "\n ( "
<> formatExportList (map (Export ExportModule) reexportedModules)
<> "\n"
<> formatExportList exports
<> " ) where\n\n"
<> T.unlines (map ("import " <>) reexportedModules)
importDeps :: ModulePath -> [ModulePath] -> Text
importDeps _ [] = ""
importDeps (ModulePath prefix) deps = T.unlines . map toImport $ deps
where toImport :: ModulePath -> Text
toImport dep = let impSt = if importSource dep
then "import {-# SOURCE #-} qualified "
else "import qualified "
in impSt <> dotWithPrefix dep <>
" as " <> qualifiedModuleName dep
importSource :: ModulePath -> Bool
importSource (ModulePath [_, "Callbacks"]) = False
importSource (ModulePath mp) = take (length prefix) mp == prefix
moduleImports :: Text
moduleImports = T.unlines [
"import Data.GI.Base.ShortPrelude"
, "import qualified Data.GI.Base.ShortPrelude as SP"
, "import qualified Data.GI.Base.Overloading as O"
, "import qualified Prelude as P"
, ""
, "import qualified Data.GI.Base.Attributes as GI.Attributes"
, "import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr"
, "import qualified Data.GI.Base.GError as B.GError"
, "import qualified Data.GI.Base.GVariant as B.GVariant"
, "import qualified Data.GI.Base.GParamSpec as B.GParamSpec"
, "import qualified Data.GI.Base.CallStack as B.CallStack"
, "import qualified Data.Text as T"
, "import qualified Data.ByteString.Char8 as B"
, "import qualified Data.Map as Map"
, "import qualified Foreign.Ptr as FP" ]
dotWithPrefix :: ModulePath -> Text
dotWithPrefix mp = dotModulePath ("GI" <> mp)
writeModuleInfo :: Bool -> Maybe FilePath -> ModuleInfo -> IO ()
writeModuleInfo verbose dirPrefix minfo = do
let submodulePaths = map (modulePath) (M.elems (submodules minfo))
submoduleExports = map dotWithPrefix submodulePaths
fname = modulePathToFilePath dirPrefix (modulePath minfo) ".hs"
dirname = takeDirectory fname
code = codeToText (moduleCode minfo)
pragmas = languagePragmas (Set.toList $ modulePragmas minfo)
optionsGHC = ghcOptions (Set.toList $ moduleGHCOpts minfo)
prelude = modulePrelude (dotWithPrefix $ modulePath minfo)
(F.toList (moduleExports minfo))
submoduleExports
imports = if ImplicitPrelude `Set.member` moduleFlags minfo
then ""
else moduleImports
pkgRoot = ModulePath (take 1 (modulePathToList $ modulePath minfo))
deps = importDeps pkgRoot (Set.toList $ qualifiedImports minfo)
haddock = moduleHaddock (moduleDoc minfo)
when verbose $ putStrLn ((T.unpack . dotWithPrefix . modulePath) minfo
++ " -> " ++ fname)
createDirectoryIfMissing True dirname
utf8WriteFile fname (T.unlines [pragmas, optionsGHC, haddock,
prelude, imports, deps, code])
when (bootCode minfo /= NoCode) $ do
let bootFName = modulePathToFilePath dirPrefix (modulePath minfo) ".hs-boot"
utf8WriteFile bootFName (genHsBoot minfo)
genHsBoot :: ModuleInfo -> Text
genHsBoot minfo =
"module " <> (dotWithPrefix . modulePath) minfo <> " where\n\n" <>
moduleImports <> "\n" <>
codeToText (bootCode minfo)
modulePathToFilePath :: Maybe FilePath -> ModulePath -> FilePath -> FilePath
modulePathToFilePath dirPrefix (ModulePath mp) ext =
joinPath (fromMaybe "" dirPrefix : "GI" : map T.unpack mp) ++ ext
writeModuleTree :: Bool -> Maybe FilePath -> ModuleInfo -> IO [Text]
writeModuleTree verbose dirPrefix minfo = do
submodulePaths <- concat <$> forM (M.elems (submodules minfo))
(writeModuleTree verbose dirPrefix)
writeModuleInfo verbose dirPrefix minfo
return $ (dotWithPrefix (modulePath minfo) : submodulePaths)
listModuleTree :: ModuleInfo -> [Text]
listModuleTree minfo =
let submodulePaths = concatMap listModuleTree (M.elems (submodules minfo))
in dotWithPrefix (modulePath minfo) : submodulePaths