{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      :  Distribution.Simple.Setup.Haddock
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the haddock command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Haddock
  ( HaddockTarget (..)
  , HaddockFlags
    ( HaddockCommonFlags
    , haddockVerbosity
    , haddockDistPref
    , haddockCabalFilePath
    , haddockWorkingDir
    , haddockTargets
    , ..
    )
  , emptyHaddockFlags
  , defaultHaddockFlags
  , haddockCommand
  , Visibility (..)
  , HaddockProjectFlags (..)
  , emptyHaddockProjectFlags
  , defaultHaddockProjectFlags
  , haddockProjectCommand
  , haddockOptions
  , haddockProjectOptions
  ) where

import Distribution.Compat.Prelude hiding (get)
import Prelude ()

import qualified Distribution.Compat.CharParsing as P
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Program
import Distribution.Simple.Setup.Common
import Distribution.Utils.Path
import Distribution.Verbosity

import qualified Text.PrettyPrint as Disp

-- ------------------------------------------------------------

-- * Haddock flags

-- ------------------------------------------------------------

-- | When we build haddock documentation, there are two cases:
--
-- 1. We build haddocks only for the current development version,
--    intended for local use and not for distribution. In this case,
--    we store the generated documentation in @<dist>/doc/html/<package name>@.
--
-- 2. We build haddocks for intended for uploading them to hackage.
--    In this case, we need to follow the layout that hackage expects
--    from documentation tarballs, and we might also want to use different
--    flags than for development builds, so in this case we store the generated
--    documentation in @<dist>/doc/html/<package id>-docs@.
data HaddockTarget = ForHackage | ForDevelopment deriving (Eq, Show, Generic)

instance Binary HaddockTarget
instance Structured HaddockTarget

instance Pretty HaddockTarget where
  pretty ForHackage = Disp.text "for-hackage"
  pretty ForDevelopment = Disp.text "for-development"

instance Parsec HaddockTarget where
  parsec =
    P.choice
      [ P.try $ P.string "for-hackage" >> return ForHackage
      , P.string "for-development" >> return ForDevelopment
      ]

data HaddockFlags = HaddockFlags
  { haddockCommonFlags :: !CommonSetupFlags
  , haddockProgramPaths :: [(String, FilePath)]
  , haddockProgramArgs :: [(String, [String])]
  , haddockHoogle :: Flag Bool
  , haddockHtml :: Flag Bool
  , haddockHtmlLocation :: Flag String
  , haddockForHackage :: Flag HaddockTarget
  , haddockExecutables :: Flag Bool
  , haddockTestSuites :: Flag Bool
  , haddockBenchmarks :: Flag Bool
  , haddockForeignLibs :: Flag Bool
  , haddockInternal :: Flag Bool
  , haddockCss :: Flag FilePath
  , haddockLinkedSource :: Flag Bool
  , haddockQuickJump :: Flag Bool
  , haddockHscolourCss :: Flag FilePath
  , haddockContents :: Flag PathTemplate
  , haddockIndex :: Flag PathTemplate
  , haddockBaseUrl :: Flag String
  , haddockResourcesDir :: Flag String
  , haddockOutputDir :: Flag FilePath
  , haddockUseUnicode :: Flag Bool
  }
  deriving (Show, Generic)

pattern HaddockCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> HaddockFlags
pattern HaddockCommonFlags
  { haddockVerbosity
  , haddockDistPref
  , haddockWorkingDir
  , haddockCabalFilePath
  , haddockTargets
  } <-
  ( haddockCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = haddockVerbosity
        , setupDistPref = haddockDistPref
        , setupWorkingDir = haddockWorkingDir
        , setupCabalFilePath = haddockCabalFilePath
        , setupTargets = haddockTargets
        }
    )

instance Binary HaddockFlags
instance Structured HaddockFlags

defaultHaddockFlags :: HaddockFlags
defaultHaddockFlags =
  HaddockFlags
    { haddockCommonFlags = defaultCommonSetupFlags
    , haddockProgramPaths = mempty
    , haddockProgramArgs = []
    , haddockHoogle = Flag False
    , haddockHtml = Flag False
    , haddockHtmlLocation = NoFlag
    , haddockForHackage = NoFlag
    , haddockExecutables = Flag False
    , haddockTestSuites = Flag False
    , haddockBenchmarks = Flag False
    , haddockForeignLibs = Flag False
    , haddockInternal = Flag False
    , haddockCss = NoFlag
    , haddockLinkedSource = Flag False
    , haddockQuickJump = Flag False
    , haddockHscolourCss = NoFlag
    , haddockContents = NoFlag
    , haddockIndex = NoFlag
    , haddockBaseUrl = NoFlag
    , haddockResourcesDir = NoFlag
    , haddockOutputDir = NoFlag
    , haddockUseUnicode = Flag False
    }

haddockCommand :: CommandUI HaddockFlags
haddockCommand =
  CommandUI
    { commandName = "haddock"
    , commandSynopsis = "Generate Haddock HTML documentation."
    , commandDescription = Just $ \_ ->
        "Requires the program haddock, version 2.x.\n"
    , commandNotes = Nothing
    , commandUsage =
        usageAlternatives "haddock" $
          [ "[FLAGS]"
          , "COMPONENTS [FLAGS]"
          ]
    , commandDefaultFlags = defaultHaddockFlags
    , commandOptions = \showOrParseArgs ->
        haddockOptions showOrParseArgs
          ++ programDbPaths
            progDb
            ParseArgs
            haddockProgramPaths
            (\v flags -> flags{haddockProgramPaths = v})
          ++ programDbOption
            progDb
            showOrParseArgs
            haddockProgramArgs
            (\v fs -> fs{haddockProgramArgs = v})
          ++ programDbOptions
            progDb
            ParseArgs
            haddockProgramArgs
            (\v flags -> flags{haddockProgramArgs = v})
    }
  where
    progDb =
      addKnownProgram haddockProgram $
        addKnownProgram ghcProgram $
          emptyProgramDb

haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
haddockOptions showOrParseArgs =
  withCommonSetupOptions
    haddockCommonFlags
    (\c f -> f{haddockCommonFlags = c})
    showOrParseArgs
    [ option
        ""
        ["hoogle"]
        "Generate a hoogle database"
        haddockHoogle
        (\v flags -> flags{haddockHoogle = v})
        trueArg
    , option
        ""
        ["html"]
        "Generate HTML documentation (the default)"
        haddockHtml
        (\v flags -> flags{haddockHtml = v})
        trueArg
    , option
        ""
        ["html-location"]
        "Location of HTML documentation for pre-requisite packages"
        haddockHtmlLocation
        (\v flags -> flags{haddockHtmlLocation = v})
        (reqArgFlag "URL")
    , option
        ""
        ["for-hackage"]
        "Collection of flags to generate documentation suitable for upload to hackage"
        haddockForHackage
        (\v flags -> flags{haddockForHackage = v})
        (noArg (Flag ForHackage))
    , option
        ""
        ["executables"]
        "Run haddock for Executables targets"
        haddockExecutables
        (\v flags -> flags{haddockExecutables = v})
        trueArg
    , option
        ""
        ["tests"]
        "Run haddock for Test Suite targets"
        haddockTestSuites
        (\v flags -> flags{haddockTestSuites = v})
        trueArg
    , option
        ""
        ["benchmarks"]
        "Run haddock for Benchmark targets"
        haddockBenchmarks
        (\v flags -> flags{haddockBenchmarks = v})
        trueArg
    , option
        ""
        ["foreign-libraries"]
        "Run haddock for Foreign Library targets"
        haddockForeignLibs
        (\v flags -> flags{haddockForeignLibs = v})
        trueArg
    , option
        ""
        ["all"]
        "Run haddock for all targets"
        ( \f ->
            allFlags
              [ haddockExecutables f
              , haddockTestSuites f
              , haddockBenchmarks f
              , haddockForeignLibs f
              ]
        )
        ( \v flags ->
            flags
              { haddockExecutables = v
              , haddockTestSuites = v
              , haddockBenchmarks = v
              , haddockForeignLibs = v
              }
        )
        trueArg
    , option
        ""
        ["internal"]
        "Run haddock for internal modules and include all symbols"
        haddockInternal
        (\v flags -> flags{haddockInternal = v})
        trueArg
    , option
        ""
        ["css"]
        "Use PATH as the haddock stylesheet"
        haddockCss
        (\v flags -> flags{haddockCss = v})
        (reqArgFlag "PATH")
    , option
        ""
        ["hyperlink-source", "hyperlink-sources", "hyperlinked-source"]
        "Hyperlink the documentation to the source code"
        haddockLinkedSource
        (\v flags -> flags{haddockLinkedSource = v})
        trueArg
    , option
        ""
        ["quickjump"]
        "Generate an index for interactive documentation navigation"
        haddockQuickJump
        (\v flags -> flags{haddockQuickJump = v})
        trueArg
    , option
        ""
        ["hscolour-css"]
        "Use PATH as the HsColour stylesheet"
        haddockHscolourCss
        (\v flags -> flags{haddockHscolourCss = v})
        (reqArgFlag "PATH")
    , option
        ""
        ["contents-location"]
        "Bake URL in as the location for the contents page"
        haddockContents
        (\v flags -> flags{haddockContents = v})
        ( reqArg'
            "URL"
            (toFlag . toPathTemplate)
            (flagToList . fmap fromPathTemplate)
        )
    , option
        ""
        ["index-location"]
        "Use a separately-generated HTML index"
        haddockIndex
        (\v flags -> flags{haddockIndex = v})
        ( reqArg'
            "URL"
            (toFlag . toPathTemplate)
            (flagToList . fmap fromPathTemplate)
        )
    , option
        ""
        ["base-url"]
        "Base URL for static files."
        haddockBaseUrl
        (\v flags -> flags{haddockBaseUrl = v})
        (reqArgFlag "URL")
    , option
        ""
        ["resources-dir"]
        "location of Haddocks static / auxiliary files"
        haddockResourcesDir
        (\v flags -> flags{haddockResourcesDir = v})
        (reqArgFlag "DIR")
    , option
        ""
        ["output-dir"]
        "Generate haddock documentation into this directory. This flag is provided as a technology preview and is subject to change in the next releases."
        haddockOutputDir
        (\v flags -> flags{haddockOutputDir = v})
        (reqArgFlag "DIR")
    , option
        ""
        ["use-unicode"]
        "Pass --use-unicode option to haddock"
        haddockUseUnicode
        (\v flags -> flags{haddockUseUnicode = v})
        trueArg
    ]

emptyHaddockFlags :: HaddockFlags
emptyHaddockFlags = mempty

instance Monoid HaddockFlags where
  mempty = gmempty
  mappend = (<>)

instance Semigroup HaddockFlags where
  (<>) = gmappend

-- ------------------------------------------------------------

-- * HaddocksFlags flags

-- ------------------------------------------------------------

-- | Governs whether modules from a given interface should be visible or
-- hidden in the Haddock generated content page.  We don't expose this
-- functionality to the user, but simply use 'Visible' for only local packages.
-- Visibility of modules is available since @haddock-2.26.1@.
data Visibility = Visible | Hidden
  deriving (Eq, Show)

data HaddockProjectFlags = HaddockProjectFlags
  { haddockProjectCommonFlags :: !CommonSetupFlags
  , haddockProjectHackage :: Flag Bool
  -- ^ a shortcut option which builds documentation linked to hackage.  It implies:
  -- * `--html-location='https://hackage.haskell.org/package/$prg-$version/docs'
  -- * `--quickjump`
  -- * `--gen-index`
  -- * `--gen-contents`
  -- * `--hyperlinked-source`
  , -- options passed to @haddock@ via 'createHaddockIndex'
    haddockProjectDir :: Flag String
  -- ^ output directory of combined haddocks, the default is './haddocks'
  , haddockProjectPrologue :: Flag String
  , haddockProjectInterfaces :: Flag [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)]
  -- ^ 'haddocksInterfaces' is inferred by the 'haddocksAction'; currently not
  -- exposed to the user.
  , -- options passed to @haddock@ via 'HaddockFlags' when building
    -- documentation

    haddockProjectProgramPaths :: [(String, FilePath)]
  , haddockProjectProgramArgs :: [(String, [String])]
  , haddockProjectHoogle :: Flag Bool
  , -- haddockHtml is not supported
    haddockProjectHtmlLocation :: Flag String
  , -- haddockForHackage is not supported
    haddockProjectExecutables :: Flag Bool
  , haddockProjectTestSuites :: Flag Bool
  , haddockProjectBenchmarks :: Flag Bool
  , haddockProjectForeignLibs :: Flag Bool
  , haddockProjectInternal :: Flag Bool
  , haddockProjectCss :: Flag FilePath
  , haddockProjectHscolourCss :: Flag FilePath
  , -- haddockContent is not supported, a fixed value is provided
    -- haddockIndex is not supported, a fixed value is provided
    -- haddockDistPerf is not supported, note: it changes location of the haddocks
    -- haddockBaseUrl is not supported, a fixed value is provided
    haddockProjectResourcesDir :: Flag String
  , haddockProjectUseUnicode :: Flag Bool
  }
  deriving (Show, Generic)

defaultHaddockProjectFlags :: HaddockProjectFlags
defaultHaddockProjectFlags =
  HaddockProjectFlags
    { haddockProjectCommonFlags = defaultCommonSetupFlags
    , haddockProjectHackage = Flag False
    , haddockProjectDir = Flag "./haddocks"
    , haddockProjectPrologue = NoFlag
    , haddockProjectTestSuites = Flag False
    , haddockProjectProgramPaths = mempty
    , haddockProjectProgramArgs = mempty
    , haddockProjectHoogle = Flag False
    , haddockProjectHtmlLocation = NoFlag
    , haddockProjectExecutables = Flag False
    , haddockProjectBenchmarks = Flag False
    , haddockProjectForeignLibs = Flag False
    , haddockProjectInternal = Flag False
    , haddockProjectCss = NoFlag
    , haddockProjectHscolourCss = NoFlag
    , haddockProjectResourcesDir = NoFlag
    , haddockProjectInterfaces = NoFlag
    , haddockProjectUseUnicode = NoFlag
    }

haddockProjectCommand :: CommandUI HaddockProjectFlags
haddockProjectCommand =
  CommandUI
    { commandName = "v2-haddock-project"
    , commandSynopsis = "Generate Haddocks HTML documentation for the cabal project."
    , commandDescription = Just $ \_ ->
        "Requires the program haddock, version 2.26.\n"
    , commandNotes = Nothing
    , commandUsage =
        usageAlternatives "haddock-project" $
          [ "[FLAGS]"
          , "COMPONENTS [FLAGS]"
          ]
    , commandDefaultFlags = defaultHaddockProjectFlags
    , commandOptions = \showOrParseArgs ->
        haddockProjectOptions showOrParseArgs
          ++ programDbPaths
            progDb
            ParseArgs
            haddockProjectProgramPaths
            (\v flags -> flags{haddockProjectProgramPaths = v})
          ++ programDbOption
            progDb
            showOrParseArgs
            haddockProjectProgramArgs
            (\v fs -> fs{haddockProjectProgramArgs = v})
          ++ programDbOptions
            progDb
            ParseArgs
            haddockProjectProgramArgs
            (\v flags -> flags{haddockProjectProgramArgs = v})
    }
  where
    progDb =
      addKnownProgram haddockProgram $
        addKnownProgram ghcProgram $
          emptyProgramDb

haddockProjectOptions :: ShowOrParseArgs -> [OptionField HaddockProjectFlags]
haddockProjectOptions showOrParseArgs =
  withCommonSetupOptions
    haddockProjectCommonFlags
    (\c f -> f{haddockProjectCommonFlags = c})
    showOrParseArgs
    [ option
        ""
        ["hackage"]
        ( concat
            [ "A short-cut option to build documentation linked to hackage."
            ]
        )
        haddockProjectHackage
        (\v flags -> flags{haddockProjectHackage = v})
        trueArg
    , option
        ""
        ["output"]
        "Output directory"
        haddockProjectDir
        (\v flags -> flags{haddockProjectDir = v})
        (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList))
    , option
        ""
        ["prologue"]
        "File path to a prologue file in haddock format"
        haddockProjectPrologue
        (\v flags -> flags{haddockProjectPrologue = v})
        (optArg' "PATH" maybeToFlag (fmap Just . flagToList))
    , option
        ""
        ["hoogle"]
        "Generate a hoogle database"
        haddockProjectHoogle
        (\v flags -> flags{haddockProjectHoogle = v})
        trueArg
    , option
        ""
        ["html-location"]
        "Location of HTML documentation for pre-requisite packages"
        haddockProjectHtmlLocation
        (\v flags -> flags{haddockProjectHtmlLocation = v})
        (reqArgFlag "URL")
    , option
        ""
        ["executables"]
        "Run haddock for Executables targets"
        haddockProjectExecutables
        (\v flags -> flags{haddockProjectExecutables = v})
        trueArg
    , option
        ""
        ["tests"]
        "Run haddock for Test Suite targets"
        haddockProjectTestSuites
        (\v flags -> flags{haddockProjectTestSuites = v})
        trueArg
    , option
        ""
        ["benchmarks"]
        "Run haddock for Benchmark targets"
        haddockProjectBenchmarks
        (\v flags -> flags{haddockProjectBenchmarks = v})
        trueArg
    , option
        ""
        ["foreign-libraries"]
        "Run haddock for Foreign Library targets"
        haddockProjectForeignLibs
        (\v flags -> flags{haddockProjectForeignLibs = v})
        trueArg
    , option
        ""
        ["all", "haddock-all"]
        "Run haddock for all targets"
        ( \f ->
            allFlags
              [ haddockProjectExecutables f
              , haddockProjectTestSuites f
              , haddockProjectBenchmarks f
              , haddockProjectForeignLibs f
              ]
        )
        ( \v flags ->
            flags
              { haddockProjectExecutables = v
              , haddockProjectTestSuites = v
              , haddockProjectBenchmarks = v
              , haddockProjectForeignLibs = v
              }
        )
        trueArg
    , option
        ""
        ["internal"]
        "Run haddock for internal modules and include all symbols"
        haddockProjectInternal
        (\v flags -> flags{haddockProjectInternal = v})
        trueArg
    , option
        ""
        ["css"]
        "Use PATH as the haddock stylesheet"
        haddockProjectCss
        (\v flags -> flags{haddockProjectCss = v})
        (reqArgFlag "PATH")
    , option
        ""
        ["hscolour-css"]
        "Use PATH as the HsColour stylesheet"
        haddockProjectHscolourCss
        (\v flags -> flags{haddockProjectHscolourCss = v})
        (reqArgFlag "PATH")
    , option
        ""
        ["resources-dir"]
        "location of Haddocks static / auxiliary files"
        haddockProjectResourcesDir
        (\v flags -> flags{haddockProjectResourcesDir = v})
        (reqArgFlag "DIR")
    , option
        ""
        ["use-unicode"]
        "Pass --use-unicode option to haddock"
        haddockProjectUseUnicode
        (\v flags -> flags{haddockProjectUseUnicode = v})
        trueArg
    ]

emptyHaddockProjectFlags :: HaddockProjectFlags
emptyHaddockProjectFlags = mempty

instance Monoid HaddockProjectFlags where
  mempty = gmempty
  mappend = (<>)

instance Semigroup HaddockProjectFlags where
  (<>) = gmappend
