{-| This module contains the top level and options parsing of the @dhall-docs@
    executable
-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Dhall.Docs
    ( -- * Options
      Options(..)
    , parserInfoOptions
    , parseOptions

      -- * Execution
    , main
    , defaultMain
    ) where

import Control.Applicative (optional, (<|>))
import Data.Text           (Text)
import Data.Version        (showVersion)
import Dhall.Docs.Core
import Dhall.Pretty        (CharacterSet (..))
import Options.Applicative (Parser, ParserInfo)
import Path                (Abs, Dir, Path)

import qualified Control.Monad
import qualified Data.Text
import qualified Data.Text.IO        as Text.IO
import qualified GHC.IO.Encoding
import qualified Options.Applicative
import qualified Path
import qualified Path.IO
import qualified Paths_dhall_docs    as Meta
import qualified System.Directory
import qualified System.Exit
import qualified System.IO

-- | Command line options
data Options
    = Options
        { Options -> FilePath
packageDir :: FilePath
          -- ^ Directory where your package resides
        , Options -> FilePath
docLink :: FilePath
          -- ^ Link to the generated documentation
        , Options -> Path Abs Dir -> Text
resolvePackageName :: Path Abs Dir -> Text
        , Options -> CharacterSet
characterSet :: CharacterSet
        , Options -> Maybe Text
baseImportUrl :: Maybe Text
        }
    | Version

-- | `Parser` for the `Options` type
parseOptions :: Parser Options
parseOptions :: Parser Options
parseOptions =
    (   FilePath
-> FilePath
-> (Path Abs Dir -> Text)
-> CharacterSet
-> Maybe Text
-> Options
Options
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
          ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"input"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar FilePath
"INPUT"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help FilePath
"Directory of your dhall package"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
Options.Applicative.action FilePath
"directory"
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
          ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"output-link"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar FilePath
"OUTPUT-LINK"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
               ( FilePath
"Path to the link targeting the directory with the generated "
               forall a. Semigroup a => a -> a -> a
<> FilePath
"documentation. The path needs to not exist or to be a "
               forall a. Semigroup a => a -> a -> a
<> FilePath
"symlink, otherwise the tool won't generate any docs at all"
                )
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
Options.Applicative.value FilePath
"./docs"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
Options.Applicative.action FilePath
"directory"
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Path Abs Dir -> Text)
parsePackageNameResolver
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CharacterSet
parseAscii
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          (forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
            (  forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"base-import-url"
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar FilePath
"URL"
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
                 (   FilePath
"Base URL for importing the package.  This is used by "
                 forall a. Semigroup a => a -> a -> a
<>  FilePath
"the 'Copy path to clipboard' feature to prepend the "
                 forall a. Semigroup a => a -> a -> a
<>  FilePath
"specified URL to all copied paths so that they can be "
                 forall a. Semigroup a => a -> a -> a
<>  FilePath
"pasted as valid imports for Dhall code"
                 )
            )
          )
    ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Options
parseVersion
  where
    switch :: FilePath -> FilePath -> Parser Bool
switch FilePath
name FilePath
description =
        Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
            (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
name
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help FilePath
description
            )

    parseAscii :: Parser CharacterSet
parseAscii = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> CharacterSet
f (FilePath -> FilePath -> Parser Bool
switch FilePath
"ascii" FilePath
"Format rendered source code using only ASCII syntax")
      where
        f :: Bool -> CharacterSet
f Bool
True  = CharacterSet
ASCII
        f Bool
False = CharacterSet
Unicode

    parseVersion :: Parser Options
parseVersion =
        forall a. a -> Mod FlagFields a -> Parser a
Options.Applicative.flag'
            Options
Version
            (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"version"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help FilePath
"Display version"
            )

    parsePackageNameResolver :: Parser (Path Abs Dir -> Text)
    parsePackageNameResolver :: Parser (Path Abs Dir -> Text)
parsePackageNameResolver = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b}. Maybe FilePath -> Path b Dir -> Text
f (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Options.Applicative.optional Parser FilePath
p)
      where
        -- Directories on the `path` modules always ends in "/", so we have
        -- to remove last one with `init`
        f :: Maybe FilePath -> Path b Dir -> Text
f  Maybe FilePath
Nothing = FilePath -> Text
Data.Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> FilePath
Path.fromRelDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Path b Dir -> Path Rel Dir
Path.dirname
        f (Just FilePath
packageName) = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Data.Text.pack FilePath
packageName

        p :: Parser FilePath
p = forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
                (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"package-name"
                forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar FilePath
"PACKAGE-NAME"
                forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
                            (  FilePath
"Override for the package name seen on HTML "
                            forall a. Semigroup a => a -> a -> a
<> FilePath
"navbars. By default, it will extract it from "
                            forall a. Semigroup a => a -> a -> a
<> FilePath
"the input"
                            )
                )

-- | `ParserInfo` for the `Options` type
parserInfoOptions :: ParserInfo Options
parserInfoOptions :: ParserInfo Options
parserInfoOptions =
    let progDesc :: FilePath
progDesc = FilePath
"Generate HTML documentation from a dhall package or file" in
    forall a. Parser a -> InfoMod a -> ParserInfo a
Options.Applicative.info
        (forall a. Parser (a -> a)
Options.Applicative.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
parseOptions)
        (   forall a. InfoMod a
Options.Applicative.fullDesc
        forall a. Semigroup a => a -> a -> a
<>  forall a. FilePath -> InfoMod a
Options.Applicative.progDesc FilePath
progDesc
        )


-- | Default execution of @dhall-docs@ command
defaultMain :: Options -> IO ()
defaultMain :: Options -> IO ()
defaultMain = \case
    Options{FilePath
Maybe Text
CharacterSet
Path Abs Dir -> Text
baseImportUrl :: Maybe Text
characterSet :: CharacterSet
resolvePackageName :: Path Abs Dir -> Text
docLink :: FilePath
packageDir :: FilePath
baseImportUrl :: Options -> Maybe Text
characterSet :: Options -> CharacterSet
resolvePackageName :: Options -> Path Abs Dir -> Text
docLink :: Options -> FilePath
packageDir :: Options -> FilePath
..} -> do
        TextEncoding -> IO ()
GHC.IO.Encoding.setLocaleEncoding TextEncoding
System.IO.utf8
        Path Abs Dir
resolvedPackageDir <- forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs Dir)
Path.IO.resolveDir' FilePath
packageDir

        Bool
outDirExists <- FilePath -> IO Bool
System.Directory.doesPathExist FilePath
docLink
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when Bool
outDirExists forall a b. (a -> b) -> a -> b
$ do
            Bool
isLink <- FilePath -> IO Bool
System.Directory.pathIsSymbolicLink FilePath
docLink
            if Bool
isLink then FilePath -> IO ()
System.Directory.removeFile FilePath
docLink
            else forall a. Text -> IO a
die forall a b. (a -> b) -> a -> b
$ Text
"The specified --output-link (" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Data.Text.pack FilePath
docLink
                    forall a. Semigroup a => a -> a -> a
<> Text
") already exists and it's not a symlink."

        Path Abs Dir
resolvedDocLink <- forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs Dir)
Path.IO.resolveDir' FilePath
docLink
        let packageName :: Text
packageName = Path Abs Dir -> Text
resolvePackageName Path Abs Dir
resolvedPackageDir
        Path Abs Dir
-> Path Abs Dir -> Maybe Text -> Text -> CharacterSet -> IO ()
generateDocs Path Abs Dir
resolvedPackageDir Path Abs Dir
resolvedDocLink Maybe Text
baseImportUrl Text
packageName CharacterSet
characterSet
    Options
Version ->
        FilePath -> IO ()
putStrLn (Version -> FilePath
showVersion Version
Meta.version)

die :: Text -> IO a
die :: forall a. Text -> IO a
die Text
e = do
    Handle -> Text -> IO ()
Text.IO.hPutStrLn Handle
System.IO.stderr Text
e

    forall a. IO a
System.Exit.exitFailure

-- | Entry point for the @dhall-docs@ executable
main :: IO ()
main :: IO ()
main = forall a. ParserInfo a -> IO a
Options.Applicative.execParser ParserInfo Options
parserInfoOptions forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Options -> IO ()
defaultMain