module Haskell.Docs.Index where
import Control.Exception as E
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy as L
import Data.Char
import Data.Either
import Data.Function
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as M
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Text (Text,pack)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Documentation.Haddock
import GHC hiding (verbosity)
import Haskell.Docs.Cabal
import Haskell.Docs.Ghc
import Haskell.Docs.Haddock
import Name
import PackageConfig
import System.Directory
import System.FilePath
import System.IO
lookupIdent :: Text
-> IO (Maybe (HashMap Text [Text]))
lookupIdent ident =
do d <- getTemporaryDirectory
exists <- doesFileExist (d </> indexFilename)
if exists
then lookupInIndex ident
else do generateIndex >>= saveIndex
lookupInIndex ident
type Index = HashMap Text Text
generateIndex :: IO Index
generateIndex =
do flatfile <- generateFlatFile
evaluate
(foldl' (\m (pkg,modu,name) ->
M.insertWith (\x y -> x <> " " <> y)
(pack name)
(pack pkg <> ":" <> pack modu) m)
M.empty
flatfile)
where (<>) = mappend
generateFlatFile :: IO [(String, String, String)]
generateFlatFile =
do packages <- getAllPackages
fmap (concat . map explode . concat)
(forM packages
(\package ->
do files <- getHaddockInterfacesByPackage package
return
(concat
(map (map (\iface ->
(sourcePackageId package,instMod iface,instExports iface)) .
ifInstalledIfaces)
(rights files)))))
where explode (pkg,modu,names) =
map (showPackageName pkg
,moduleNameString (moduleName modu)
,)
(map getOccString names)
saveIndex :: Index -> IO ()
saveIndex i =
do d <- getTemporaryDirectory
L.writeFile (d </> indexFilename) mempty
h <- openFile (d </> indexFilename) AppendMode
forM_ (M.toList i)
(\(ident,modules) -> T.hPutStrLn h (ident <> " " <> modules))
hClose h
where (<>) = mappend
indexFilename :: FilePath
indexFilename = "haskell-docs-indents.index"
lookupInIndex
:: Text
-> IO (Maybe (HashMap Text [Text]))
lookupInIndex (T.encodeUtf8 -> ident) =
do d <- getTemporaryDirectory
h <- openFile (d </> indexFilename) ReadMode
E.catch
(fix (\loop ->
do line <- S.hGetLine h
if S.takeWhile (/= space) line == ident
then do hClose h
return (Just (extractModules (S.drop 1 (S.dropWhile (/= space) line))))
else loop))
(\(_ :: IOException) -> return Nothing)
where space = S.c2w ' '
extractModules :: ByteString -> HashMap Text [Text]
extractModules = foldl' ins mempty . mapMaybe unpair . chunks . T.decodeUtf8
where chunks = T.split isSpace
unpair t = case T.split (==':') t of
[package,modu] -> Just (package,modu)
_ -> Nothing
ins m (pkg,modu) = M.insertWith (++) pkg [modu] m