{-# LANGUAGE CPP #-}
module Development.IDE.Spans.Documentation (
getDocumentation
, getDocumentationTryGhc
, getDocumentationsTryGhc
, DocMap
, mkDocMap
) where
import Control.Monad
import Control.Monad.Extra (findM)
import Control.Monad.IO.Class
import Data.Either
import Data.Foldable
import Data.List.Extra
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as S
import qualified Data.Text as T
import Development.IDE.Core.Compile
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Error
import Development.IDE.GHC.Util (printOutputable)
import Development.IDE.Spans.Common
import Language.LSP.Protocol.Types (filePathToUri, getUri)
import Prelude hiding (mod)
import System.Directory
import System.FilePath
mkDocMap
:: HscEnv
-> RefMap a
-> TcGblEnv
-> IO DocAndTyThingMap
mkDocMap :: forall a. HscEnv -> RefMap a -> TcGblEnv -> IO DocAndTyThingMap
mkDocMap HscEnv
env RefMap a
rm TcGblEnv
this_mod =
do
#if MIN_VERSION_ghc(9,3,0)
(Just Docs{docs_decls :: Docs -> UniqMap Name [HsDoc GhcRn]
docs_decls = UniqMap UniqFM Name (Name, [HsDoc GhcRn])
this_docs}) <- DynFlags -> TcGblEnv -> IO (Maybe Docs)
forall (m :: * -> *).
MonadIO m =>
DynFlags -> TcGblEnv -> m (Maybe Docs)
extractDocs (HscEnv -> DynFlags
hsc_dflags HscEnv
env) TcGblEnv
this_mod
#else
(_ , DeclDocMap this_docs, _) <- extractDocs this_mod
#endif
#if MIN_VERSION_ghc(9,3,0)
NameEnv SpanDoc
d <- (Name -> NameEnv SpanDoc -> IO (NameEnv SpanDoc))
-> NameEnv SpanDoc -> [Name] -> IO (NameEnv SpanDoc)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM Name -> NameEnv SpanDoc -> IO (NameEnv SpanDoc)
getDocs (((Name, [HsDoc GhcRn]) -> SpanDoc)
-> UniqFM Name (Name, [HsDoc GhcRn]) -> NameEnv SpanDoc
forall a b. (a -> b) -> UniqFM Name a -> UniqFM Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Name
_, [HsDoc GhcRn]
x) -> ((HsDoc GhcRn -> HsDocString) -> [HsDoc GhcRn] -> [HsDocString]
forall a b. (a -> b) -> [a] -> [b]
map HsDoc GhcRn -> HsDocString
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString [HsDoc GhcRn]
x) [HsDocString] -> SpanDocUris -> SpanDoc
`SpanDocString` Maybe Text -> Maybe Text -> SpanDocUris
SpanDocUris Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) UniqFM Name (Name, [HsDoc GhcRn])
this_docs) [Name]
names
#else
d <- foldrM getDocs (mkNameEnv $ M.toList $ fmap (`SpanDocString` SpanDocUris Nothing Nothing) this_docs) names
#endif
NameEnv TyThing
k <- (Name -> NameEnv TyThing -> IO (NameEnv TyThing))
-> NameEnv TyThing -> [Name] -> IO (NameEnv TyThing)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM Name -> NameEnv TyThing -> IO (NameEnv TyThing)
getType (TcGblEnv -> NameEnv TyThing
tcg_type_env TcGblEnv
this_mod) [Name]
names
DocAndTyThingMap -> IO DocAndTyThingMap
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DocAndTyThingMap -> IO DocAndTyThingMap)
-> DocAndTyThingMap -> IO DocAndTyThingMap
forall a b. (a -> b) -> a -> b
$ NameEnv SpanDoc -> NameEnv TyThing -> DocAndTyThingMap
DKMap NameEnv SpanDoc
d NameEnv TyThing
k
where
getDocs :: Name -> NameEnv SpanDoc -> IO (NameEnv SpanDoc)
getDocs Name
n NameEnv SpanDoc
nameMap
| Bool -> (Module -> Bool) -> Maybe Module -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Module
mod ==) (Maybe Module -> Bool) -> Maybe Module -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Module
nameModule_maybe Name
n = NameEnv SpanDoc -> IO (NameEnv SpanDoc)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameEnv SpanDoc
nameMap
| Bool
otherwise = do
SpanDoc
doc <- HscEnv -> Name -> IO SpanDoc
getDocumentationTryGhc HscEnv
env Name
n
NameEnv SpanDoc -> IO (NameEnv SpanDoc)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NameEnv SpanDoc -> IO (NameEnv SpanDoc))
-> NameEnv SpanDoc -> IO (NameEnv SpanDoc)
forall a b. (a -> b) -> a -> b
$ NameEnv SpanDoc -> Name -> SpanDoc -> NameEnv SpanDoc
forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv NameEnv SpanDoc
nameMap Name
n SpanDoc
doc
getType :: Name -> NameEnv TyThing -> IO (NameEnv TyThing)
getType Name
n NameEnv TyThing
nameMap
| Maybe TyThing
Nothing <- NameEnv TyThing -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv TyThing
nameMap Name
n
= do Maybe TyThing
kind <- HscEnv -> Name -> IO (Maybe TyThing)
lookupKind HscEnv
env Name
n
NameEnv TyThing -> IO (NameEnv TyThing)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NameEnv TyThing -> IO (NameEnv TyThing))
-> NameEnv TyThing -> IO (NameEnv TyThing)
forall a b. (a -> b) -> a -> b
$ NameEnv TyThing
-> (TyThing -> NameEnv TyThing) -> Maybe TyThing -> NameEnv TyThing
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NameEnv TyThing
nameMap (NameEnv TyThing -> Name -> TyThing -> NameEnv TyThing
forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv NameEnv TyThing
nameMap Name
n) Maybe TyThing
kind
| Bool
otherwise = NameEnv TyThing -> IO (NameEnv TyThing)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameEnv TyThing
nameMap
names :: [Name]
names = [Either ModuleName Name] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Either ModuleName Name] -> [Name])
-> [Either ModuleName Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ Set (Either ModuleName Name) -> [Either ModuleName Name]
forall a. Set a -> [a]
S.toList Set (Either ModuleName Name)
idents
idents :: Set (Either ModuleName Name)
idents = RefMap a -> Set (Either ModuleName Name)
forall k a. Map k a -> Set k
M.keysSet RefMap a
rm
mod :: Module
mod = TcGblEnv -> Module
tcg_mod TcGblEnv
this_mod
lookupKind :: HscEnv -> Name -> IO (Maybe TyThing)
lookupKind :: HscEnv -> Name -> IO (Maybe TyThing)
lookupKind HscEnv
env =
(Either [FileDiagnostic] (Maybe TyThing) -> Maybe TyThing)
-> IO (Either [FileDiagnostic] (Maybe TyThing))
-> IO (Maybe TyThing)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe TyThing
-> Either [FileDiagnostic] (Maybe TyThing) -> Maybe TyThing
forall b a. b -> Either a b -> b
fromRight Maybe TyThing
forall a. Maybe a
Nothing) (IO (Either [FileDiagnostic] (Maybe TyThing))
-> IO (Maybe TyThing))
-> (Name -> IO (Either [FileDiagnostic] (Maybe TyThing)))
-> Name
-> IO (Maybe TyThing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags
-> Text
-> IO (Maybe TyThing)
-> IO (Either [FileDiagnostic] (Maybe TyThing))
forall a.
DynFlags -> Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors (HscEnv -> DynFlags
hsc_dflags HscEnv
env) Text
"span" (IO (Maybe TyThing)
-> IO (Either [FileDiagnostic] (Maybe TyThing)))
-> (Name -> IO (Maybe TyThing))
-> Name
-> IO (Either [FileDiagnostic] (Maybe TyThing))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> Name -> IO (Maybe TyThing)
lookupName HscEnv
env
getDocumentationTryGhc :: HscEnv -> Name -> IO SpanDoc
getDocumentationTryGhc :: HscEnv -> Name -> IO SpanDoc
getDocumentationTryGhc HscEnv
env Name
n =
(SpanDoc -> Maybe SpanDoc -> SpanDoc
forall a. a -> Maybe a -> a
fromMaybe SpanDoc
emptySpanDoc (Maybe SpanDoc -> SpanDoc)
-> ([SpanDoc] -> Maybe SpanDoc) -> [SpanDoc] -> SpanDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SpanDoc] -> Maybe SpanDoc
forall a. [a] -> Maybe a
listToMaybe ([SpanDoc] -> SpanDoc) -> IO [SpanDoc] -> IO SpanDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> [Name] -> IO [SpanDoc]
getDocumentationsTryGhc HscEnv
env [Name
n])
IO SpanDoc -> (IOEnvFailure -> IO SpanDoc) -> IO SpanDoc
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(IOEnvFailure
_ :: IOEnvFailure) -> SpanDoc -> IO SpanDoc
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpanDoc
emptySpanDoc)
getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [SpanDoc]
getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [SpanDoc]
getDocumentationsTryGhc HscEnv
env [Name]
names = do
Either
[FileDiagnostic]
[Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
resOr <- DynFlags
-> Text
-> IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> IO
(Either
[FileDiagnostic]
[Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))])
forall a.
DynFlags -> Text -> IO a -> IO (Either [FileDiagnostic] a)
catchSrcErrors (HscEnv -> DynFlags
hsc_dflags HscEnv
env) Text
"docs" (IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> IO
(Either
[FileDiagnostic]
[Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]))
-> IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> IO
(Either
[FileDiagnostic]
[Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))])
forall a b. (a -> b) -> a -> b
$ HscEnv
-> [Name]
-> IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
getDocsBatch HscEnv
env [Name]
names
case Either
[FileDiagnostic]
[Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
resOr of
Left [FileDiagnostic]
_ -> [SpanDoc] -> IO [SpanDoc]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
res -> (Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
-> Name -> IO SpanDoc)
-> [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
-> [Name]
-> IO [SpanDoc]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
-> Name -> IO SpanDoc
forall {f :: * -> *} {a} {pass} {b}.
MonadIO f =>
Either a (Maybe [WithHsDocIdentifiers HsDocString pass], b)
-> Name -> f SpanDoc
unwrap [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
res [Name]
names
where
#if MIN_VERSION_ghc(9,3,0)
unwrap :: Either a (Maybe [WithHsDocIdentifiers HsDocString pass], b)
-> Name -> f SpanDoc
unwrap (Right (Just [WithHsDocIdentifiers HsDocString pass]
docs, b
_)) Name
n = [HsDocString] -> SpanDocUris -> SpanDoc
SpanDocString ((WithHsDocIdentifiers HsDocString pass -> HsDocString)
-> [WithHsDocIdentifiers HsDocString pass] -> [HsDocString]
forall a b. (a -> b) -> [a] -> [b]
map WithHsDocIdentifiers HsDocString pass -> HsDocString
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString [WithHsDocIdentifiers HsDocString pass]
docs) (SpanDocUris -> SpanDoc) -> f SpanDocUris -> f SpanDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f SpanDocUris
forall {m :: * -> *}. MonadIO m => Name -> m SpanDocUris
getUris Name
n
#else
unwrap (Right (Just docs, _)) n = SpanDocString docs <$> getUris n
#endif
unwrap Either a (Maybe [WithHsDocIdentifiers HsDocString pass], b)
_ Name
n = Name -> f SpanDoc
forall {f :: * -> *}. MonadIO f => Name -> f SpanDoc
mkSpanDocText Name
n
mkSpanDocText :: Name -> f SpanDoc
mkSpanDocText Name
name =
[Text] -> SpanDocUris -> SpanDoc
SpanDocText [] (SpanDocUris -> SpanDoc) -> f SpanDocUris -> f SpanDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f SpanDocUris
forall {m :: * -> *}. MonadIO m => Name -> m SpanDocUris
getUris Name
name
getUris :: Name -> m SpanDocUris
getUris Name
name = do
(Maybe Text
docFu, Maybe Text
srcFu) <-
case Name -> Maybe Module
nameModule_maybe Name
name of
Just Module
mod -> IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text))
-> IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
Maybe Text
doc <- IO (Maybe String) -> IO (Maybe Text)
toFileUriText (IO (Maybe String) -> IO (Maybe Text))
-> IO (Maybe String) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ HscEnv -> Module -> IO (Maybe String)
lookupDocHtmlForModule HscEnv
env Module
mod
Maybe Text
src <- IO (Maybe String) -> IO (Maybe Text)
toFileUriText (IO (Maybe String) -> IO (Maybe Text))
-> IO (Maybe String) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ HscEnv -> Module -> IO (Maybe String)
lookupSrcHtmlForModule HscEnv
env Module
mod
(Maybe Text, Maybe Text) -> IO (Maybe Text, Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
doc, Maybe Text
src)
Maybe Module
Nothing -> (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing)
let docUri :: Maybe Text
docUri = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
selector Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall a. Outputable a => a -> Text
printOutputable Name
name) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
docFu
srcUri :: Maybe Text
srcUri = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall a. Outputable a => a -> Text
printOutputable Name
name) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
srcFu
selector :: Text
selector
| Name -> Bool
isValName Name
name = Text
"v:"
| Bool
otherwise = Text
"t:"
SpanDocUris -> m SpanDocUris
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SpanDocUris -> m SpanDocUris) -> SpanDocUris -> m SpanDocUris
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Maybe Text -> SpanDocUris
SpanDocUris Maybe Text
docUri Maybe Text
srcUri
toFileUriText :: IO (Maybe String) -> IO (Maybe Text)
toFileUriText = ((Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text))
-> ((String -> Text) -> Maybe String -> Maybe Text)
-> (String -> Text)
-> IO (Maybe String)
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Uri -> Text
getUri (Uri -> Text) -> (String -> Uri) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Uri
filePathToUri)
getDocumentation
:: HasSrcSpan name
=> [ParsedModule]
-> name
-> [T.Text]
getDocumentation :: forall name. HasSrcSpan name => [ParsedModule] -> name -> [Text]
getDocumentation [ParsedModule]
_sources name
_targetName = []
lookupDocHtmlForModule :: HscEnv -> Module -> IO (Maybe FilePath)
lookupDocHtmlForModule :: HscEnv -> Module -> IO (Maybe String)
lookupDocHtmlForModule =
(String -> String -> String)
-> HscEnv -> Module -> IO (Maybe String)
lookupHtmlForModule (\String
pkgDocDir String
modDocName -> String
pkgDocDir String -> String -> String
</> String
modDocName String -> String -> String
<.> String
"html")
lookupSrcHtmlForModule :: HscEnv -> Module -> IO (Maybe FilePath)
lookupSrcHtmlForModule :: HscEnv -> Module -> IO (Maybe String)
lookupSrcHtmlForModule =
(String -> String -> String)
-> HscEnv -> Module -> IO (Maybe String)
lookupHtmlForModule (\String
pkgDocDir String
modDocName -> String
pkgDocDir String -> String -> String
</> String
"src" String -> String -> String
</> String
modDocName String -> String -> String
<.> String
"html")
lookupHtmlForModule :: (FilePath -> FilePath -> FilePath) -> HscEnv -> Module -> IO (Maybe FilePath)
lookupHtmlForModule :: (String -> String -> String)
-> HscEnv -> Module -> IO (Maybe String)
lookupHtmlForModule String -> String -> String
mkDocPath HscEnv
hscEnv Module
m = do
let mfs :: Maybe [String]
mfs = ([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
go) (HscEnv -> GenUnit UnitId -> Maybe [String]
lookupHtmls HscEnv
hscEnv GenUnit UnitId
ui)
Maybe String
html <- (String -> IO Bool) -> [String] -> IO (Maybe String)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM String -> IO Bool
doesFileExist ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (Maybe [String] -> [[String]]) -> Maybe [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [String] -> [[String]]
forall a. Maybe a -> [a]
maybeToList (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Maybe [String]
mfs)
(String -> IO String) -> Maybe String -> IO (Maybe String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse String -> IO String
canonicalizePath Maybe String
html
where
go :: String -> [String]
go String
pkgDocDir = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
mkDocPath String
pkgDocDir) [String]
mns
ui :: GenUnit UnitId
ui = Module -> GenUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit Module
m
mns :: [String]
mns = do
[String]
chunks <- ([[String]] -> [[String]]
forall a. [a] -> [a]
reverse ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [a] -> [a]
drop1 ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. [a] -> [[a]]
inits ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
splitOn String
".") (String -> [[String]]) -> String -> [[String]]
forall a b. (a -> b) -> a -> b
$ (ModuleName -> String
moduleNameString (ModuleName -> String)
-> (Module -> ModuleName) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName) Module
m
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
`intercalate` [String]
chunks) [String
".", String
"-"]
lookupHtmls :: HscEnv -> Unit -> Maybe [FilePath]
lookupHtmls :: HscEnv -> GenUnit UnitId -> Maybe [String]
lookupHtmls HscEnv
df GenUnit UnitId
ui =
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeDirectory ([String] -> [String])
-> (UnitInfo -> [String]) -> UnitInfo -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [String]
unitHaddockInterfaces (UnitInfo -> [String]) -> Maybe UnitInfo -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> GenUnit UnitId -> Maybe UnitInfo
lookupUnit HscEnv
df GenUnit UnitId
ui