Doc.hs

{-# 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)