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

    parseAscii :: Parser CharacterSet
parseAscii = (Bool -> CharacterSet) -> Parser Bool -> Parser CharacterSet
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 =
        Options -> Mod FlagFields Options -> Parser Options
forall a. a -> Mod FlagFields a -> Parser a
Options.Applicative.flag'
            Options
Version
            (   FilePath -> Mod FlagFields Options
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"version"
            Mod FlagFields Options
-> Mod FlagFields Options -> Mod FlagFields Options
forall a. Semigroup a => a -> a -> a
<>  FilePath -> Mod FlagFields Options
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 = (Maybe FilePath -> Path Abs Dir -> Text)
-> Parser (Maybe FilePath) -> Parser (Path Abs Dir -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Path Abs Dir -> Text
forall b. Maybe FilePath -> Path b Dir -> Text
f (Parser FilePath -> Parser (Maybe FilePath)
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 (FilePath -> Text)
-> (Path b Dir -> FilePath) -> Path b Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
init (FilePath -> FilePath)
-> (Path b Dir -> FilePath) -> Path b Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> FilePath
Path.fromRelDir (Path Rel Dir -> FilePath)
-> (Path b Dir -> Path Rel Dir) -> Path b Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
Path.dirname
        f (Just FilePath
packageName) = Text -> Path b Dir -> Text
forall a b. a -> b -> a
const (Text -> Path b Dir -> Text) -> Text -> Path b Dir -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Data.Text.pack FilePath
packageName

        p :: Parser FilePath
p = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
                (   FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"package-name"
                Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>  FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar FilePath
"PACKAGE-NAME"
                Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>  FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
                            (  FilePath
"Override for the package name seen on HTML "
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"navbars. By default, it will extract it from "
                            FilePath -> FilePath -> FilePath
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
    Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.Applicative.info
        (Parser (Options -> Options)
forall a. Parser (a -> a)
Options.Applicative.helper Parser (Options -> Options) -> Parser Options -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
parseOptions)
        (   InfoMod Options
forall a. InfoMod a
Options.Applicative.fullDesc
        InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<>  FilePath -> InfoMod Options
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 <- FilePath -> IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs Dir)
Path.IO.resolveDir' FilePath
packageDir

        Bool
outDirExists <- FilePath -> IO Bool
System.Directory.doesPathExist FilePath
docLink
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when Bool
outDirExists (IO () -> IO ()) -> IO () -> IO ()
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 Text -> IO ()
forall a. Text -> IO a
die (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"The specified --output-link (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Data.Text.pack FilePath
docLink
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") already exists and it's not a symlink."

        Path Abs Dir
resolvedDocLink <- FilePath -> IO (Path Abs Dir)
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 :: Text -> IO a
die Text
e = do
    Handle -> Text -> IO ()
Text.IO.hPutStrLn Handle
System.IO.stderr Text
e

    IO a
forall a. IO a
System.Exit.exitFailure

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