{-# LANGUAGE PatternGuards #-}

{-# LANGUAGE DataKinds #-}

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE TemplateHaskell #-}

-- | Utilities for built documentation, shared between @stack@ and @stack-doc-server@.

module Stack.Build.Doc where

import Control.Monad

import Data.List

import Data.Map.Strict (Map)

import qualified Data.Map.Strict as M

import Data.Maybe

import qualified Data.Text as T

import Path

import Stack.Types

import Stack.Constants

import System.Directory

import System.Environment (lookupEnv)

import System.FilePath (takeFileName)

-- | Get all packages included in documentation from directory.

getDocPackages :: Path Abs Dir -> IO (Map PackageName [Version])

getDocPackages loc =

do ls <- fmap (map (toFilePath loc ++)) (getDirectoryContents (toFilePath loc))

mdirs <- forM ls (\e -> do isDir <- doesDirectoryExist e

return $ if isDir then (Just e) else Nothing)

let sorted = -- Sort by package name ascending, version descending

sortBy (\(pa,va) (pb,vb) ->

case compare pa pb of

EQ -> compare vb va

o -> o)

(mapMaybe breakPkgVer (catMaybes mdirs))

return (M.fromAscListWith (++) (map (\(k,v) -> (k,[v])) sorted))

-- | Split a documentation directory name into package name and version.

breakPkgVer :: FilePath -> Maybe (PackageName,Version)

breakPkgVer pkgPath =

case T.breakOnEnd "-"

(T.pack (takeFileName pkgPath)) of

("",_) -> Nothing

(pkgD,verT) ->

let pkgstr = T.dropEnd 1 pkgD

in case parseVersionFromString (T.unpack verT) of

Just v

| Just pkg <-

parsePackageNameFromString (T.unpack pkgstr) ->

Just (pkg,v)

_ -> Nothing

-- | Construct a documentation directory name from package name and version.

joinPkgVer :: (PackageName,Version) -> FilePath

joinPkgVer (pkg,ver) = (packageNameString pkg ++ "-" ++ versionString ver)

--EKB TODO: doc generation for stack-doc-server

-- | Get location of user-generated documentation if it exists.

getExistingUserDocPath :: Config -> IO (Maybe (Path Abs Dir))

getExistingUserDocPath config = do

let docPath = userDocsDir config

docExists <- doesDirectoryExist (toFilePath docPath)

if docExists

then return (Just docPath)

else return Nothing

--EKB TODO: doc generation for stack-doc-server

-- | Get location of global package docs.

getGlobalDocPath :: IO (Maybe (Path Abs Dir))

getGlobalDocPath = do

--EKB TODO: move this location into Config

maybeRootEnv <- lookupEnv "STACK_DOC_ROOT"

case maybeRootEnv of

Nothing -> return Nothing

Just rootEnv -> do

pkgDocPath <- parseAbsDir rootEnv

pkgDocExists <- doesDirectoryExist (toFilePath pkgDocPath)

return (if pkgDocExists then Just pkgDocPath else Nothing)

--EKB TODO: doc generation for stack-doc-server

-- | Get location of GHC docs.

getGhcDocPath :: IO (Maybe (Path Abs Dir))

getGhcDocPath = do

maybeGhcPathS <- findExecutable "ghc"

case maybeGhcPathS of

Nothing -> return Nothing

Just ghcPathS -> do

ghcPath <- parseAbsFile ghcPathS

let ghcDocPath = parent (parent ghcPath) </> $(mkRelDir "share/doc/ghc/html/")

ghcDocExists <- doesDirectoryExist (toFilePath ghcDocPath)

return (if ghcDocExists then Just ghcDocPath else Nothing)