module Hhp.PkgDoc (packageDoc) where

import System.Process (readProcess)

import Hhp.Types
import Hhp.GhcPkg

-- | Obtaining the package name and the doc path of a module.
packageDoc :: Options
           -> Cradle
           -> ModuleString
           -> IO String
packageDoc :: Options -> Cradle -> ModuleString -> IO ModuleString
packageDoc Options
_ Cradle
cradle ModuleString
mdl = Cradle -> ModuleString -> IO ModuleString
pkgDoc Cradle
cradle ModuleString
mdl

pkgDoc :: Cradle -> String -> IO String
pkgDoc :: Cradle -> ModuleString -> IO ModuleString
pkgDoc Cradle
cradle ModuleString
mdl = do
    ModuleString
pkg <- ModuleString -> ModuleString
trim (ModuleString -> ModuleString)
-> IO ModuleString -> IO ModuleString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleString -> [ModuleString] -> ModuleString -> IO ModuleString
readProcess ModuleString
"ghc-pkg" [ModuleString]
toModuleOpts []
    if ModuleString
pkg ModuleString -> ModuleString -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleString
"" then
        ModuleString -> IO ModuleString
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleString
"\n"
      else do
        ModuleString
htmlpath <- ModuleString -> [ModuleString] -> ModuleString -> IO ModuleString
readProcess ModuleString
"ghc-pkg" (ModuleString -> [ModuleString]
toDocDirOpts ModuleString
pkg) []
        let ret :: ModuleString
ret = ModuleString
pkg ModuleString -> ModuleString -> ModuleString
forall a. [a] -> [a] -> [a]
++ ModuleString
" " ModuleString -> ModuleString -> ModuleString
forall a. [a] -> [a] -> [a]
++ Int -> ModuleString -> ModuleString
forall a. Int -> [a] -> [a]
drop Int
14 ModuleString
htmlpath
        ModuleString -> IO ModuleString
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleString
ret
  where
    toModuleOpts :: [ModuleString]
toModuleOpts = [ModuleString
"find-module", ModuleString
mdl, ModuleString
"--simple-output"]
                   [ModuleString] -> [ModuleString] -> [ModuleString]
forall a. [a] -> [a] -> [a]
++ [GhcPkgDb] -> [ModuleString]
ghcPkgDbStackOpts (Cradle -> [GhcPkgDb]
cradlePkgDbStack Cradle
cradle)
    toDocDirOpts :: ModuleString -> [ModuleString]
toDocDirOpts ModuleString
pkg = [ModuleString
"field", ModuleString
pkg, ModuleString
"haddock-html"]
                       [ModuleString] -> [ModuleString] -> [ModuleString]
forall a. [a] -> [a] -> [a]
++ [GhcPkgDb] -> [ModuleString]
ghcPkgDbStackOpts (Cradle -> [GhcPkgDb]
cradlePkgDbStack Cradle
cradle)
    trim :: ModuleString -> ModuleString
trim = (Char -> Bool) -> ModuleString -> ModuleString
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> ModuleString -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ModuleString
" \n")