{-| Contains all the functions that generate documentation

    We should always try to do as little work as possible in an `IO` context.
    To do so, just wrap your function in `IO` if you need to do I/O operations,
    and make pure functions receive that IO result as an input
-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE ViewPatterns          #-}
-- {-# OPTIONS_GHC -Wno-unused-imports #-}

module Dhall.Docs.Core
    ( -- * Core functionality
      generateDocs
    , generateDocsPure
    , GeneratedDocs(..)

      -- * Comment parsing
    , module Dhall.Docs.Comment
    ) where

import Control.Applicative        (Alternative (..))
import Control.Monad.Writer.Class (MonadWriter)
import Data.ByteString            (ByteString)
import Data.Function              (on)
import Data.Map.Strict            (Map)
import Data.Text                  (Text)
import Data.Void                  (Void)
import Dhall.Core
    ( Binding (..)
    , Expr (..)
    , Import
    , MultiLet (..)
    , Var (..)
    , denote
    )
import Dhall.Docs.Comment
import Dhall.Docs.Embedded
import Dhall.Docs.Html
import Dhall.Docs.Markdown
import Dhall.Docs.Store
import Dhall.Parser
    ( Header (..)
    , ParseError (..)
    , exprAndHeaderFromText
    )
import Dhall.Pretty               (CharacterSet)
import Dhall.Src                  (Src)
import Path                       (Abs, Dir, File, Path, Rel, (</>))
import Text.Megaparsec            (ParseErrorBundle (..))

import qualified Control.Applicative        as Applicative
import qualified Control.Monad
import qualified Control.Monad.Writer.Class as Writer
import qualified Data.ByteString
import qualified Data.List
import qualified Data.List.NonEmpty         as NonEmpty
import qualified Data.Map.Strict            as Map
import qualified Data.Maybe
import qualified Data.Maybe                 as Maybe
import qualified Data.Text
import qualified Data.Text.Encoding
import qualified Data.Text.IO               as Text.IO
import qualified Data.Text.Lazy             as Text.Lazy
import qualified Dhall.Core
import qualified Lucid
import qualified Path
import qualified Path.IO
import qualified System.FilePath            as FilePath
import qualified Text.Megaparsec

-- $setup
-- >>> :set -XQuasiQuotes
-- >>> import Path (reldir)

-- | The result of the doc-generator pure component
data GeneratedDocs a = GeneratedDocs [DocsGenWarning] a

instance Functor GeneratedDocs where
    fmap :: (a -> b) -> GeneratedDocs a -> GeneratedDocs b
fmap a -> b
f (GeneratedDocs [DocsGenWarning]
w a
a) = [DocsGenWarning] -> b -> GeneratedDocs b
forall a. [DocsGenWarning] -> a -> GeneratedDocs a
GeneratedDocs [DocsGenWarning]
w (a -> b
f a
a)

instance Applicative GeneratedDocs where
    pure :: a -> GeneratedDocs a
pure = [DocsGenWarning] -> a -> GeneratedDocs a
forall a. [DocsGenWarning] -> a -> GeneratedDocs a
GeneratedDocs []

    GeneratedDocs [DocsGenWarning]
w a -> b
f <*> :: GeneratedDocs (a -> b) -> GeneratedDocs a -> GeneratedDocs b
<*> GeneratedDocs [DocsGenWarning]
w' a
a = [DocsGenWarning] -> b -> GeneratedDocs b
forall a. [DocsGenWarning] -> a -> GeneratedDocs a
GeneratedDocs ([DocsGenWarning]
w [DocsGenWarning] -> [DocsGenWarning] -> [DocsGenWarning]
forall a. Semigroup a => a -> a -> a
<> [DocsGenWarning]
w') (a -> b
f a
a)

instance Monad GeneratedDocs where
    GeneratedDocs [DocsGenWarning]
w a
a >>= :: GeneratedDocs a -> (a -> GeneratedDocs b) -> GeneratedDocs b
>>= a -> GeneratedDocs b
f =
        let GeneratedDocs [DocsGenWarning]
w' b
b = a -> GeneratedDocs b
f a
a
            in [DocsGenWarning] -> b -> GeneratedDocs b
forall a. [DocsGenWarning] -> a -> GeneratedDocs a
GeneratedDocs ([DocsGenWarning]
w [DocsGenWarning] -> [DocsGenWarning] -> [DocsGenWarning]
forall a. Semigroup a => a -> a -> a
<> [DocsGenWarning]
w') b
b

instance MonadWriter [DocsGenWarning] GeneratedDocs where
    tell :: [DocsGenWarning] -> GeneratedDocs ()
tell [DocsGenWarning]
w = [DocsGenWarning] -> () -> GeneratedDocs ()
forall a. [DocsGenWarning] -> a -> GeneratedDocs a
GeneratedDocs [DocsGenWarning]
w ()

    listen :: GeneratedDocs a -> GeneratedDocs (a, [DocsGenWarning])
listen (GeneratedDocs [DocsGenWarning]
w a
a) = [DocsGenWarning]
-> (a, [DocsGenWarning]) -> GeneratedDocs (a, [DocsGenWarning])
forall a. [DocsGenWarning] -> a -> GeneratedDocs a
GeneratedDocs [DocsGenWarning]
w (a
a, [DocsGenWarning]
w)
    pass :: GeneratedDocs (a, [DocsGenWarning] -> [DocsGenWarning])
-> GeneratedDocs a
pass (GeneratedDocs [DocsGenWarning]
w (a
a, [DocsGenWarning] -> [DocsGenWarning]
f)) = [DocsGenWarning] -> a -> GeneratedDocs a
forall a. [DocsGenWarning] -> a -> GeneratedDocs a
GeneratedDocs ([DocsGenWarning] -> [DocsGenWarning]
f [DocsGenWarning]
w) a
a

data DocsGenWarning
    = InvalidDhall (Text.Megaparsec.ParseErrorBundle Text Void)
    | InvalidMarkdown MarkdownParseError
    | DhallDocsCommentError (Path Rel File) CommentParseError

warn :: String
warn :: String
warn = String
"\n\ESC[1;33mWarning\ESC[0m: "

instance Show DocsGenWarning where
    show :: DocsGenWarning -> String
show (InvalidDhall ParseErrorBundle Text Void
err) =
        String
warn String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Invalid Input\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Text.Megaparsec.errorBundlePretty ParseErrorBundle Text Void
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
"... documentation won't be generated for this file"

    show (InvalidMarkdown MarkdownParseError{ParseErrorBundle Text MMarkErr
unwrap :: MarkdownParseError -> ParseErrorBundle Text MMarkErr
unwrap :: ParseErrorBundle Text MMarkErr
..}) =
        String
warn String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"Header comment is not markdown\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        ParseErrorBundle Text MMarkErr -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Text.Megaparsec.errorBundlePretty ParseErrorBundle Text MMarkErr
unwrap String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
"The original non-markdown text will be pasted in the documentation"

    show (DhallDocsCommentError Path Rel File
path CommentParseError
err) =
        String
warn String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Path Rel File -> String
Path.fromRelFile Path Rel File
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
specificError
      where
        specificError :: String
specificError = case CommentParseError
err of
            CommentParseError
MissingNewlineOnBlockComment -> String
": After the `|` marker of a block comment " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                String
"there must be a newline (either \\n or \\r\\n)"

            CommentParseError
SeveralSubseqDhallDocsComments -> String
": Two dhall-docs comments in the same " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                String
"comment section are forbidden"

            CommentParseError
BadSingleLineCommentsAlignment -> String
": dhall-docs's single line comments " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                String
"must be aligned"

            CommentParseError
BadPrefixesOnSingleLineComments -> String
": dhall-docs's single line comments " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                String
"must have specific prefixes:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                String
"* For the first line: \"--| \"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                String
"* For the rest of the linse: \"--  \""

-- | Extracted text from from Dhall file's comments
newtype FileComments = FileComments
    { FileComments -> Maybe DhallDocsText
headerComment :: Maybe DhallDocsText -- ^ 'Nothing' if no comment or if invalid
    }

-- | Represents a Dhall file that can be rendered as documentation.
--   If you'd like to improve or add features to a .dhall documentation page,
--   add that extra information here.
data DhallFile = DhallFile
    { DhallFile -> Path Rel File
path :: Path Rel File             -- ^ Path of the file
    , DhallFile -> Text
contents :: Text                  -- ^ File contents
    , DhallFile -> Expr Src Import
expr :: Expr Src Import           -- ^ Parsed AST from 'contents'
    , DhallFile -> Maybe (Expr Void Import)
mType :: Maybe (Expr Void Import) -- ^ Type of the parsed expression,
                                        --   extracted from the source code
    , DhallFile -> [Expr Void Import]
examples :: [Expr Void Import]    -- ^ Examples extracted from assertions
                                        --   in the file
    , DhallFile -> FileComments
fileComments :: FileComments
    }

{-| Takes a list of files paths with their contents and returns the list of
    valid `DhallFile`s.

    Returned files contains all the information to be used on `Html ()`
    generation.

    The result is sorted by `path`
-}
getAllDhallFiles :: [(Path Rel File, ByteString)] -> GeneratedDocs [DhallFile]
getAllDhallFiles :: [(Path Rel File, ByteString)] -> GeneratedDocs [DhallFile]
getAllDhallFiles = ([Maybe DhallFile] -> [DhallFile])
-> GeneratedDocs [Maybe DhallFile] -> GeneratedDocs [DhallFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe DhallFile] -> [DhallFile]
forall a. [Maybe a] -> [a]
Maybe.catMaybes (GeneratedDocs [Maybe DhallFile] -> GeneratedDocs [DhallFile])
-> ([(Path Rel File, ByteString)]
    -> GeneratedDocs [Maybe DhallFile])
-> [(Path Rel File, ByteString)]
-> GeneratedDocs [DhallFile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path Rel File, Text) -> GeneratedDocs (Maybe DhallFile))
-> [(Path Rel File, Text)] -> GeneratedDocs [Maybe DhallFile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Path Rel File, Text) -> GeneratedDocs (Maybe DhallFile)
toDhallFile ([(Path Rel File, Text)] -> GeneratedDocs [Maybe DhallFile])
-> ([(Path Rel File, ByteString)] -> [(Path Rel File, Text)])
-> [(Path Rel File, ByteString)]
-> GeneratedDocs [Maybe DhallFile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path Rel File, ByteString)
 -> [(Path Rel File, Text)] -> [(Path Rel File, Text)])
-> [(Path Rel File, Text)]
-> [(Path Rel File, ByteString)]
-> [(Path Rel File, Text)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Path Rel File, ByteString)
-> [(Path Rel File, Text)] -> [(Path Rel File, Text)]
validFiles [] ([(Path Rel File, ByteString)] -> [(Path Rel File, Text)])
-> ([(Path Rel File, ByteString)] -> [(Path Rel File, ByteString)])
-> [(Path Rel File, ByteString)]
-> [(Path Rel File, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path Rel File, ByteString) -> Bool)
-> [(Path Rel File, ByteString)] -> [(Path Rel File, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Path Rel File, ByteString) -> Bool
forall a. (Path Rel File, a) -> Bool
hasDhallExtension
  where
    hasDhallExtension :: (Path Rel File, a) -> Bool
    hasDhallExtension :: (Path Rel File, a) -> Bool
hasDhallExtension (Path Rel File
absFile, a
_) = case Path Rel File -> Maybe (Path Rel File, String)
forall (m :: * -> *) b.
MonadThrow m =>
Path b File -> m (Path b File, String)
Path.splitExtension Path Rel File
absFile of
        Maybe (Path Rel File, String)
Nothing -> Bool
False
        Just (Path Rel File
_, String
ext) -> String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".dhall"

    validFiles :: (Path Rel File, ByteString) -> [(Path Rel File, Text)] -> [(Path Rel File, Text)]
    validFiles :: (Path Rel File, ByteString)
-> [(Path Rel File, Text)] -> [(Path Rel File, Text)]
validFiles (Path Rel File
relFile, ByteString
content) [(Path Rel File, Text)]
xs = case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
content of
        Left UnicodeException
_ -> [(Path Rel File, Text)]
xs
        Right Text
textContent -> (Path Rel File
relFile, Text
textContent) (Path Rel File, Text)
-> [(Path Rel File, Text)] -> [(Path Rel File, Text)]
forall a. a -> [a] -> [a]
: [(Path Rel File, Text)]
xs

    toDhallFile :: (Path Rel File, Text) -> GeneratedDocs (Maybe DhallFile)
    toDhallFile :: (Path Rel File, Text) -> GeneratedDocs (Maybe DhallFile)
toDhallFile (Path Rel File
relFile, Text
contents) =
        case String -> Text -> Either ParseError (Header, Expr Src Import)
exprAndHeaderFromText (Path Rel File -> String
Path.fromRelFile Path Rel File
relFile) Text
contents of
            Right (Header Text
header, Expr Src Import
expr) -> do
                let denoted :: Expr Void Import
denoted = Expr Src Import -> Expr Void Import
forall s a t. Expr s a -> Expr t a
denote Expr Src Import
expr :: Expr Void Import

                Maybe DhallDocsText
headerContents <-
                    case String -> Text -> Maybe (Either [CommentParseError] DhallDocsText)
parseSingleDhallDocsComment (Path Rel File -> String
Path.fromRelFile Path Rel File
relFile) Text
header of
                        Maybe (Either [CommentParseError] DhallDocsText)
Nothing -> Maybe DhallDocsText -> GeneratedDocs (Maybe DhallDocsText)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DhallDocsText
forall a. Maybe a
Nothing
                        Just (Left [CommentParseError]
errs) -> do
                            [DocsGenWarning] -> GeneratedDocs ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell ([DocsGenWarning] -> GeneratedDocs ())
-> [DocsGenWarning] -> GeneratedDocs ()
forall a b. (a -> b) -> a -> b
$ (CommentParseError -> DocsGenWarning)
-> [CommentParseError] -> [DocsGenWarning]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel File -> CommentParseError -> DocsGenWarning
DhallDocsCommentError Path Rel File
relFile) [CommentParseError]
errs
                            Maybe DhallDocsText -> GeneratedDocs (Maybe DhallDocsText)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DhallDocsText
forall a. Maybe a
Nothing
                        Just (Right DhallDocsText
c) -> Maybe DhallDocsText -> GeneratedDocs (Maybe DhallDocsText)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DhallDocsText -> GeneratedDocs (Maybe DhallDocsText))
-> Maybe DhallDocsText -> GeneratedDocs (Maybe DhallDocsText)
forall a b. (a -> b) -> a -> b
$ DhallDocsText -> Maybe DhallDocsText
forall a. a -> Maybe a
Just DhallDocsText
c

                Maybe DhallFile -> GeneratedDocs (Maybe DhallFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DhallFile -> GeneratedDocs (Maybe DhallFile))
-> Maybe DhallFile -> GeneratedDocs (Maybe DhallFile)
forall a b. (a -> b) -> a -> b
$ DhallFile -> Maybe DhallFile
forall a. a -> Maybe a
Just (DhallFile -> Maybe DhallFile) -> DhallFile -> Maybe DhallFile
forall a b. (a -> b) -> a -> b
$ DhallFile :: Path Rel File
-> Text
-> Expr Src Import
-> Maybe (Expr Void Import)
-> [Expr Void Import]
-> FileComments
-> DhallFile
DhallFile
                    { Expr Src Import
expr :: Expr Src Import
expr :: Expr Src Import
expr, Text
contents :: Text
contents :: Text
contents
                    , path :: Path Rel File
path = Path Rel File
relFile
                    , mType :: Maybe (Expr Void Import)
mType = Expr Void Import -> Maybe (Expr Void Import)
extractTypeIfInSource Expr Void Import
denoted
                    , examples :: [Expr Void Import]
examples = Expr Void Import -> [Expr Void Import]
examplesFromAssertions Expr Void Import
denoted
                    , fileComments :: FileComments
fileComments = Maybe DhallDocsText -> FileComments
FileComments Maybe DhallDocsText
headerContents
                    }
            Left ParseError{Text
ParseErrorBundle Text Void
unwrap :: ParseError -> ParseErrorBundle Text Void
input :: ParseError -> Text
input :: Text
unwrap :: ParseErrorBundle Text Void
..} -> do
                [DocsGenWarning] -> GeneratedDocs ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [ParseErrorBundle Text Void -> DocsGenWarning
InvalidDhall ParseErrorBundle Text Void
unwrap]
                Maybe DhallFile -> GeneratedDocs (Maybe DhallFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DhallFile
forall a. Maybe a
Nothing

    bindings :: Expr Void Import -> [Binding Void Import]
    bindings :: Expr Void Import -> [Binding Void Import]
bindings Expr Void Import
expr = case Expr Void Import
expr of
        Let b :: Binding Void Import
b@Binding{} Expr Void Import
e ->
            let MultiLet NonEmpty (Binding Void Import)
bs Expr Void Import
_ = Binding Void Import -> Expr Void Import -> MultiLet Void Import
forall s a. Binding s a -> Expr s a -> MultiLet s a
Dhall.Core.multiLet Binding Void Import
b Expr Void Import
e
            in NonEmpty (Binding Void Import) -> [Binding Void Import]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Binding Void Import)
bs
        Expr Void Import
_ -> []

    extractTypeIfInSource :: Expr Void Import -> Maybe (Expr Void Import)
    extractTypeIfInSource :: Expr Void Import -> Maybe (Expr Void Import)
extractTypeIfInSource Expr Void Import
expr =
            Expr Void Import -> Maybe (Expr Void Import)
forall (f :: * -> *) s a. Alternative f => Expr s a -> f (Expr s a)
fromOrdinaryAnnotation Expr Void Import
expr
        Maybe (Expr Void Import)
-> Maybe (Expr Void Import) -> Maybe (Expr Void Import)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Expr Void Import)
fromLetBindingAnnotation
      where
        fromOrdinaryAnnotation :: Expr s a -> f (Expr s a)
fromOrdinaryAnnotation (Let Binding s a
_ Expr s a
e)    = Expr s a -> f (Expr s a)
fromOrdinaryAnnotation Expr s a
e
        fromOrdinaryAnnotation (Annot Expr s a
_ Expr s a
_T) = Expr s a -> f (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
_T
        fromOrdinaryAnnotation  Expr s a
_           = f (Expr s a)
forall (f :: * -> *) a. Alternative f => f a
empty

        fromLetBindingAnnotation :: Maybe (Expr Void Import)
fromLetBindingAnnotation = do
            V Text
name Int
index <- Expr Void Import -> Maybe Var
maybeNameInLet Expr Void Import
expr
            (Binding Maybe Void
_ Text
_ Maybe Void
_ (Just (Maybe Void
_, Expr Void Import
exprType)) Maybe Void
_ Expr Void Import
_) <-
                Int -> [Binding Void Import] -> Maybe (Binding Void Import)
getLetBindingWithIndex Int
index ([Binding Void Import] -> Maybe (Binding Void Import))
-> [Binding Void Import] -> Maybe (Binding Void Import)
forall a b. (a -> b) -> a -> b
$ Text -> [Binding Void Import]
getLetBindingsWithName Text
name
            Expr Void Import -> Maybe (Expr Void Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Void Import
exprType

        -- | For an expression of the form @let x0 = y0 let x1 = y1 ... in e@
        --   where @e@ is a variable, maybeNameInLet returns the variable name.
        maybeNameInLet :: Expr Void Import -> Maybe Var
        maybeNameInLet :: Expr Void Import -> Maybe Var
maybeNameInLet (Var v :: Var
v@(V Text
_ Int
_)) = Var -> Maybe Var
forall a. a -> Maybe a
Just Var
v
        maybeNameInLet (Let Binding Void Import
_ Expr Void Import
e) = Expr Void Import -> Maybe Var
maybeNameInLet Expr Void Import
e
        maybeNameInLet Expr Void Import
_ = Maybe Var
forall a. Maybe a
Nothing


        {-| For an expression of the form @let x0 = y0 let x1 = y1 ... in e@
            and a variable name @v@, this returns every @xi@ that is equal to
            v in the reverse order of the source code.

            For example, take a file like this:

        >   let x = 1
        >   let y = 2
        >   let z = 3
        >   in x + y + z

            ... this will return the bindings in this order: [z, y, x]

            Only the "global" level of the file is analyzed
        -}
        getLetBindingsWithName :: Text -> [Binding Void Import]
        getLetBindingsWithName :: Text -> [Binding Void Import]
getLetBindingsWithName Text
name = (Binding Void Import -> Bool)
-> [Binding Void Import] -> [Binding Void Import]
forall a. (a -> Bool) -> [a] -> [a]
filter Binding Void Import -> Bool
forall s a. Binding s a -> Bool
bindName ([Binding Void Import] -> [Binding Void Import])
-> [Binding Void Import] -> [Binding Void Import]
forall a b. (a -> b) -> a -> b
$ [Binding Void Import] -> [Binding Void Import]
forall a. [a] -> [a]
reverse ([Binding Void Import] -> [Binding Void Import])
-> [Binding Void Import] -> [Binding Void Import]
forall a b. (a -> b) -> a -> b
$ Expr Void Import -> [Binding Void Import]
bindings Expr Void Import
expr
          where
            bindName :: Binding s a -> Bool
bindName (Binding Maybe s
_ Text
x Maybe s
_ Maybe (Maybe s, Expr s a)
_ Maybe s
_ Expr s a
_) = Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name


        getLetBindingWithIndex :: Int -> [Binding Void Import] -> Maybe (Binding Void Import)
        getLetBindingWithIndex :: Int -> [Binding Void Import] -> Maybe (Binding Void Import)
getLetBindingWithIndex Int
i [Binding Void Import]
bs =
            case Int -> [Binding Void Import] -> [Binding Void Import]
forall a. Int -> [a] -> [a]
drop Int
i [Binding Void Import]
bs of
                [] -> Maybe (Binding Void Import)
forall a. Maybe a
Nothing
                Binding Void Import
binding : [Binding Void Import]
_ -> Binding Void Import -> Maybe (Binding Void Import)
forall a. a -> Maybe a
Just Binding Void Import
binding

    examplesFromAssertions :: Expr Void Import -> [Expr Void Import]
    examplesFromAssertions :: Expr Void Import -> [Expr Void Import]
examplesFromAssertions Expr Void Import
expr = (Expr Void Import -> Maybe (Expr Void Import))
-> [Expr Void Import] -> [Expr Void Import]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Expr Void Import -> Maybe (Expr Void Import)
fromAssertion [Expr Void Import]
values
      where
        values :: [Expr Void Import]
        values :: [Expr Void Import]
values = (Binding Void Import -> Expr Void Import)
-> [Binding Void Import] -> [Expr Void Import]
forall a b. (a -> b) -> [a] -> [b]
map Binding Void Import -> Expr Void Import
forall s a. Binding s a -> Expr s a
value ([Binding Void Import] -> [Expr Void Import])
-> [Binding Void Import] -> [Expr Void Import]
forall a b. (a -> b) -> a -> b
$ Expr Void Import -> [Binding Void Import]
bindings Expr Void Import
expr

        fromAssertion :: Expr Void Import -> Maybe (Expr Void Import)
        fromAssertion :: Expr Void Import -> Maybe (Expr Void Import)
fromAssertion (Assert Expr Void Import
e) =  Expr Void Import -> Maybe (Expr Void Import)
forall a. a -> Maybe a
Just Expr Void Import
e
        fromAssertion Expr Void Import
_ = Maybe (Expr Void Import)
forall a. Maybe a
Nothing


{-| Given a relative path, returns as much @..\/@ misdirections as needed
    to go to @.@

>>> resolveRelativePath [reldir|.|]
""
>>> resolveRelativePath [reldir|a|]
"../"
>>> resolveRelativePath [reldir|a/b/c|]
"../../../"
-}
resolveRelativePath :: Path Rel Dir -> FilePath
resolveRelativePath :: Path Rel Dir -> String
resolveRelativePath Path Rel Dir
currentDir =
    case ShowS
FilePath.dropTrailingPathSeparator ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> String
Path.fromRelDir Path Rel Dir
currentDir of
        String
"." -> String
""
        String
_ -> String
"../" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Path Rel Dir -> String
resolveRelativePath (Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel Dir
currentDir)

{-| Generates `Text` from the HTML representation of a `DhallFile`
-}
makeHtml
    :: Text                 -- ^ Package name
    -> CharacterSet         -- ^ Output encoding
    -> DhallFile            -- ^ Parsed header
    -> GeneratedDocs Text
makeHtml :: Text -> CharacterSet -> DhallFile -> GeneratedDocs Text
makeHtml Text
packageName CharacterSet
characterSet DhallFile {[Expr Void Import]
Maybe (Expr Void Import)
Text
Expr Src Import
Path Rel File
FileComments
fileComments :: FileComments
examples :: [Expr Void Import]
mType :: Maybe (Expr Void Import)
expr :: Expr Src Import
contents :: Text
path :: Path Rel File
fileComments :: DhallFile -> FileComments
examples :: DhallFile -> [Expr Void Import]
mType :: DhallFile -> Maybe (Expr Void Import)
expr :: DhallFile -> Expr Src Import
contents :: DhallFile -> Text
path :: DhallFile -> Path Rel File
..} = do
    let relativeResourcesPath :: String
relativeResourcesPath = Path Rel Dir -> String
resolveRelativePath (Path Rel Dir -> String) -> Path Rel Dir -> String
forall a b. (a -> b) -> a -> b
$ Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel File
path
    let strippedHeader :: Text
strippedHeader = Text -> (DhallDocsText -> Text) -> Maybe DhallDocsText -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
Maybe.maybe Text
"" DhallDocsText -> Text
unDhallDocsText (FileComments -> Maybe DhallDocsText
headerComment FileComments
fileComments)
    HtmlT Identity ()
headerAsHtml <-
        case Path Rel File
-> Text -> Either MarkdownParseError (HtmlT Identity ())
markdownToHtml Path Rel File
path Text
strippedHeader of
            Left MarkdownParseError
err -> do
                [DocsGenWarning] -> GeneratedDocs ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [MarkdownParseError -> DocsGenWarning
InvalidMarkdown MarkdownParseError
err]
                HtmlT Identity () -> GeneratedDocs (HtmlT Identity ())
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlT Identity () -> GeneratedDocs (HtmlT Identity ()))
-> HtmlT Identity () -> GeneratedDocs (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
Lucid.toHtml Text
strippedHeader
            Right HtmlT Identity ()
html -> HtmlT Identity () -> GeneratedDocs (HtmlT Identity ())
forall (m :: * -> *) a. Monad m => a -> m a
return HtmlT Identity ()
html

    let htmlAsText :: Text
htmlAsText = Text -> Text
Text.Lazy.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Text
forall a. Html a -> Text
Lucid.renderText (HtmlT Identity () -> Text) -> HtmlT Identity () -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel File
-> Text
-> Expr Src Import
-> [Expr Void Import]
-> HtmlT Identity ()
-> DocParams
-> HtmlT Identity ()
dhallFileToHtml
            Path Rel File
path
            Text
contents
            Expr Src Import
expr
            [Expr Void Import]
examples
            HtmlT Identity ()
headerAsHtml
            DocParams :: String -> Text -> CharacterSet -> DocParams
DocParams { String
relativeResourcesPath :: String
relativeResourcesPath :: String
relativeResourcesPath, Text
packageName :: Text
packageName :: Text
packageName, CharacterSet
characterSet :: CharacterSet
characterSet :: CharacterSet
characterSet }

    Text -> GeneratedDocs Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
htmlAsText

{-| Create an @index.html@ file on each available folder in the input.

    Each @index.html@ lists the files and directories of its directory. Listed
    directories will be compacted as much as it cans to improve readability.

    For example, take the following directory-tree structure

    > .
    > ├── a
    > │   └── b
    > │       └── c
    > │           └── b.dhall
    > └── a.dhall

    To improve navigation, the index at @./index.html@ should list
    @a/b/c@ and no @index.html@ should be generated inside of `a/` or
    `a/b/`, but yes on `a/b/c/` in the last one there is the @b.dhall@ file
-}
createIndexes :: Text -> CharacterSet -> [DhallFile] -> [(Path Rel File, Text)]
createIndexes :: Text -> CharacterSet -> [DhallFile] -> [(Path Rel File, Text)]
createIndexes Text
packageName CharacterSet
characterSet [DhallFile]
files = ((Path Rel Dir, ([DhallFile], [Path Rel Dir]))
 -> (Path Rel File, Text))
-> [(Path Rel Dir, ([DhallFile], [Path Rel Dir]))]
-> [(Path Rel File, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir, ([DhallFile], [Path Rel Dir]))
-> (Path Rel File, Text)
toIndex [(Path Rel Dir, ([DhallFile], [Path Rel Dir]))]
dirToDirsAndFilesMapAssocs
  where
    -- Files grouped by their directory
    dirToFilesMap :: Map (Path Rel Dir) [DhallFile]
    dirToFilesMap :: Map (Path Rel Dir) [DhallFile]
dirToFilesMap = ([DhallFile] -> [DhallFile] -> [DhallFile])
-> [Map (Path Rel Dir) [DhallFile]]
-> Map (Path Rel Dir) [DhallFile]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [DhallFile] -> [DhallFile] -> [DhallFile]
forall a. Semigroup a => a -> a -> a
(<>) ([Map (Path Rel Dir) [DhallFile]]
 -> Map (Path Rel Dir) [DhallFile])
-> [Map (Path Rel Dir) [DhallFile]]
-> Map (Path Rel Dir) [DhallFile]
forall a b. (a -> b) -> a -> b
$ (DhallFile -> Map (Path Rel Dir) [DhallFile])
-> [DhallFile] -> [Map (Path Rel Dir) [DhallFile]]
forall a b. (a -> b) -> [a] -> [b]
map DhallFile -> Map (Path Rel Dir) [DhallFile]
toMap ([DhallFile] -> [Map (Path Rel Dir) [DhallFile]])
-> [DhallFile] -> [Map (Path Rel Dir) [DhallFile]]
forall a b. (a -> b) -> a -> b
$ (DhallFile -> DhallFile -> Ordering) -> [DhallFile] -> [DhallFile]
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (Path Rel File -> Path Rel File -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Path Rel File -> Path Rel File -> Ordering)
-> (DhallFile -> Path Rel File)
-> DhallFile
-> DhallFile
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DhallFile -> Path Rel File
path) [DhallFile]
files
      where
        toMap :: DhallFile -> Map (Path Rel Dir) [DhallFile]
        toMap :: DhallFile -> Map (Path Rel Dir) [DhallFile]
toMap DhallFile
dhallFile = Path Rel Dir -> [DhallFile] -> Map (Path Rel Dir) [DhallFile]
forall k a. k -> a -> Map k a
Map.singleton (Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent (Path Rel File -> Path Rel Dir) -> Path Rel File -> Path Rel Dir
forall a b. (a -> b) -> a -> b
$ DhallFile -> Path Rel File
path DhallFile
dhallFile) [DhallFile
dhallFile]

    {-  This is used to compute the list of exported packages on each folder.
        We try to compress the folders as much as we can. See `createIndexes`
        documentation to get more information.
    -}
    dirToDirsMap :: Map (Path Rel Dir) [Path Rel Dir]
    dirToDirsMap :: Map (Path Rel Dir) [Path Rel Dir]
dirToDirsMap = ([Path Rel Dir] -> [Path Rel Dir])
-> Map (Path Rel Dir) [Path Rel Dir]
-> Map (Path Rel Dir) [Path Rel Dir]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [Path Rel Dir] -> [Path Rel Dir]
removeHereDir (Map (Path Rel Dir) [Path Rel Dir]
 -> Map (Path Rel Dir) [Path Rel Dir])
-> Map (Path Rel Dir) [Path Rel Dir]
-> Map (Path Rel Dir) [Path Rel Dir]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir
 -> Map (Path Rel Dir) [Path Rel Dir]
 -> Map (Path Rel Dir) [Path Rel Dir])
-> Map (Path Rel Dir) [Path Rel Dir]
-> [Path Rel Dir]
-> Map (Path Rel Dir) [Path Rel Dir]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Path Rel Dir
-> Map (Path Rel Dir) [Path Rel Dir]
-> Map (Path Rel Dir) [Path Rel Dir]
go Map (Path Rel Dir) [Path Rel Dir]
initialMap [Path Rel Dir]
dirs
      where
        -- > removeHeredir [$(mkRelDir "a"), $(mkRelDir ".")]
        --   [$(mkRelDir "a")]
        removeHereDir :: [Path Rel Dir] -> [Path Rel Dir]
        removeHereDir :: [Path Rel Dir] -> [Path Rel Dir]
removeHereDir = (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter Path Rel Dir -> Bool
f
          where
            f :: Path Rel Dir -> Bool
            f :: Path Rel Dir -> Bool
f Path Rel Dir
reldir = Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel Dir
reldir Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
/= Path Rel Dir
reldir

        dirs :: [Path Rel Dir]
        dirs :: [Path Rel Dir]
dirs = Map (Path Rel Dir) [DhallFile] -> [Path Rel Dir]
forall k a. Map k a -> [k]
Map.keys Map (Path Rel Dir) [DhallFile]
dirToFilesMap

        initialMap :: Map (Path Rel Dir) [Path Rel Dir]
        initialMap :: Map (Path Rel Dir) [Path Rel Dir]
initialMap = [(Path Rel Dir, [Path Rel Dir])]
-> Map (Path Rel Dir) [Path Rel Dir]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Path Rel Dir, [Path Rel Dir])]
 -> Map (Path Rel Dir) [Path Rel Dir])
-> [(Path Rel Dir, [Path Rel Dir])]
-> Map (Path Rel Dir) [Path Rel Dir]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> (Path Rel Dir, [Path Rel Dir]))
-> [Path Rel Dir] -> [(Path Rel Dir, [Path Rel Dir])]
forall a b. (a -> b) -> [a] -> [b]
map (,[]) [Path Rel Dir]
dirs

        go :: Path Rel Dir -> Map (Path Rel Dir) [Path Rel Dir] -> Map (Path Rel Dir) [Path Rel Dir]
        go :: Path Rel Dir
-> Map (Path Rel Dir) [Path Rel Dir]
-> Map (Path Rel Dir) [Path Rel Dir]
go Path Rel Dir
d Map (Path Rel Dir) [Path Rel Dir]
dirMap = ([Path Rel Dir] -> [Path Rel Dir])
-> Path Rel Dir
-> Map (Path Rel Dir) [Path Rel Dir]
-> Map (Path Rel Dir) [Path Rel Dir]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ([Path Rel Dir
d] [Path Rel Dir] -> [Path Rel Dir] -> [Path Rel Dir]
forall a. Semigroup a => a -> a -> a
<>) (Path Rel Dir -> Path Rel Dir
key (Path Rel Dir -> Path Rel Dir) -> Path Rel Dir -> Path Rel Dir
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel Dir
d) Map (Path Rel Dir) [Path Rel Dir]
dirMap
          where
            key :: Path Rel Dir -> Path Rel Dir
            key :: Path Rel Dir -> Path Rel Dir
key Path Rel Dir
dir = if Path Rel Dir
dir Path Rel Dir -> Map (Path Rel Dir) [Path Rel Dir] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (Path Rel Dir) [Path Rel Dir]
dirMap then Path Rel Dir
dir else Path Rel Dir -> Path Rel Dir
key (Path Rel Dir -> Path Rel Dir) -> Path Rel Dir -> Path Rel Dir
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel Dir
dir

    dirToDirsAndFilesMapAssocs :: [(Path Rel Dir, ([DhallFile], [Path Rel Dir]))]
    dirToDirsAndFilesMapAssocs :: [(Path Rel Dir, ([DhallFile], [Path Rel Dir]))]
dirToDirsAndFilesMapAssocs = Map (Path Rel Dir) ([DhallFile], [Path Rel Dir])
-> [(Path Rel Dir, ([DhallFile], [Path Rel Dir]))]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map (Path Rel Dir) ([DhallFile], [Path Rel Dir])
 -> [(Path Rel Dir, ([DhallFile], [Path Rel Dir]))])
-> Map (Path Rel Dir) ([DhallFile], [Path Rel Dir])
-> [(Path Rel Dir, ([DhallFile], [Path Rel Dir]))]
forall a b. (a -> b) -> a -> b
$ (Path Rel Dir -> [DhallFile] -> ([DhallFile], [Path Rel Dir]))
-> Map (Path Rel Dir) [DhallFile]
-> Map (Path Rel Dir) ([DhallFile], [Path Rel Dir])
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Path Rel Dir -> [DhallFile] -> ([DhallFile], [Path Rel Dir])
f Map (Path Rel Dir) [DhallFile]
dirToFilesMap
      where
        f :: Path Rel Dir -> [DhallFile] -> ([DhallFile], [Path Rel Dir])
        f :: Path Rel Dir -> [DhallFile] -> ([DhallFile], [Path Rel Dir])
f Path Rel Dir
dir [DhallFile]
dhallFiles = case Map (Path Rel Dir) [Path Rel Dir]
dirToDirsMap Map (Path Rel Dir) [Path Rel Dir]
-> Path Rel Dir -> Maybe [Path Rel Dir]
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Path Rel Dir
dir of
            Maybe [Path Rel Dir]
Nothing -> Text -> ([DhallFile], [Path Rel Dir])
forall a. Text -> a
fileAnIssue Text
"dirToDirsAndFilesMapAssocs"
            Just [Path Rel Dir]
dirs -> ([DhallFile]
dhallFiles, [Path Rel Dir]
dirs)

    toIndex :: (Path Rel Dir, ([DhallFile], [Path Rel Dir])) -> (Path Rel File, Text)
    toIndex :: (Path Rel Dir, ([DhallFile], [Path Rel Dir]))
-> (Path Rel File, Text)
toIndex (Path Rel Dir
indexDir, ([DhallFile]
dhallFiles, [Path Rel Dir]
dirs)) =
        (Path Rel Dir
indexDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(Path.mkRelFile "index.html"), Text -> Text
Text.Lazy.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Text
forall a. Html a -> Text
Lucid.renderText HtmlT Identity ()
html)
      where
        html :: HtmlT Identity ()
html = Path Rel Dir
-> [(Path Rel File, Maybe (Expr Void Import))]
-> [Path Rel Dir]
-> DocParams
-> HtmlT Identity ()
indexToHtml
            Path Rel Dir
indexDir
            ((DhallFile -> (Path Rel File, Maybe (Expr Void Import)))
-> [DhallFile] -> [(Path Rel File, Maybe (Expr Void Import))]
forall a b. (a -> b) -> [a] -> [b]
map (\DhallFile{[Expr Void Import]
Maybe (Expr Void Import)
Text
Expr Src Import
Path Rel File
FileComments
fileComments :: FileComments
examples :: [Expr Void Import]
mType :: Maybe (Expr Void Import)
expr :: Expr Src Import
contents :: Text
path :: Path Rel File
fileComments :: DhallFile -> FileComments
examples :: DhallFile -> [Expr Void Import]
mType :: DhallFile -> Maybe (Expr Void Import)
expr :: DhallFile -> Expr Src Import
contents :: DhallFile -> Text
path :: DhallFile -> Path Rel File
..} -> (Path Rel File -> Path Rel File
forall a. Path Rel a -> Path Rel a
stripPrefix (Path Rel File -> Path Rel File) -> Path Rel File -> Path Rel File
forall a b. (a -> b) -> a -> b
$ Path Rel File -> Path Rel File
addHtmlExt Path Rel File
path, Maybe (Expr Void Import)
mType)) [DhallFile]
dhallFiles)
            ((Path Rel Dir -> Path Rel Dir) -> [Path Rel Dir] -> [Path Rel Dir]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel Dir -> Path Rel Dir
forall a. Path Rel a -> Path Rel a
stripPrefix [Path Rel Dir]
dirs)
            DocParams :: String -> Text -> CharacterSet -> DocParams
DocParams { relativeResourcesPath :: String
relativeResourcesPath = Path Rel Dir -> String
resolveRelativePath Path Rel Dir
indexDir, Text
packageName :: Text
packageName :: Text
packageName, CharacterSet
characterSet :: CharacterSet
characterSet :: CharacterSet
characterSet }

        stripPrefix :: Path Rel a -> Path Rel a
        stripPrefix :: Path Rel a -> Path Rel a
stripPrefix Path Rel a
relpath =
            if Path Rel a -> String
forall b t. Path b t -> String
Path.toFilePath Path Rel a
relpath String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Path Rel Dir -> String
forall b t. Path b t -> String
Path.toFilePath Path Rel Dir
indexDir then Path Rel a
relpath
            else Path Rel a -> Maybe (Path Rel a) -> Path Rel a
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (Text -> Path Rel a
forall a. Text -> a
fileAnIssue Text
"Bug+with+stripPrefix")
                (Maybe (Path Rel a) -> Path Rel a)
-> Maybe (Path Rel a) -> Path Rel a
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> Path Rel a -> Maybe (Path Rel a)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
Path.stripProperPrefix Path Rel Dir
indexDir Path Rel a
relpath

-- | Takes a file and adds an @.html@ file extension to it
addHtmlExt :: Path Rel File -> Path Rel File
addHtmlExt :: Path Rel File -> Path Rel File
addHtmlExt Path Rel File
relFile =
    Path Rel File -> Maybe (Path Rel File) -> Path Rel File
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (Text -> Path Rel File
forall a. Text -> a
fileAnIssue Text
"addHtmlExt") (Maybe (Path Rel File) -> Path Rel File)
-> Maybe (Path Rel File) -> Path Rel File
forall a b. (a -> b) -> a -> b
$ String -> Path Rel File -> Maybe (Path Rel File)
forall (m :: * -> *) b.
MonadThrow m =>
String -> Path b File -> m (Path b File)
Path.addExtension String
".html" Path Rel File
relFile

-- | If you're wondering the GitHub query params for issue creation:
-- https://docs.github.com/en/github/managing-your-work-on-github/about-automation-for-issues-and-pull-requests-with-query-parameters
fileAnIssue :: Text -> a
fileAnIssue :: Text -> a
fileAnIssue Text
titleName =
    String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"\ESC[1;31mError\ESC[0m Documentation generator bug\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>

            String
"Explanation: This error message means that there is a bug in the " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
"Dhall Documentation generator. You didn't did anything wrong, but " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
"if you would like to see this problem fixed then you should report " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
"the bug at:\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>

            String
"https://github.com/dhall-lang/dhall-haskell/issues/new?labels=dhall-docs,bug\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>

            String
"explaining your issue and add \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Data.Text.unpack Text
titleName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\" as error code " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
"so we can find the proper location in the source code where the error happened\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>

            String
"Please, also include your package in the issue. It can be in:\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
"* A compressed archive (zip, tar, etc)\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
"* A git repository, preferably with a commit reference"

{-| Generate all of the docs for a package. This function does all the `IO ()`
    related tasks to call `generateDocsPure`
-}
generateDocs
    :: Path Abs Dir -- ^ Input directory
    -> Path Abs Dir -- ^ Link to be created to the generated documentation
    -> Text         -- ^ Package name, used in some HTML titles
    -> CharacterSet -- ^ Output encoding
    -> IO ()
generateDocs :: Path Abs Dir -> Path Abs Dir -> Text -> CharacterSet -> IO ()
generateDocs Path Abs Dir
inputDir Path Abs Dir
outLink Text
packageName CharacterSet
characterSet = do
    ([Path Abs Dir]
_, [Path Abs File]
absFiles) <- Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
Path.IO.listDirRecur Path Abs Dir
inputDir
    [ByteString]
contents <- (Path Abs File -> IO ByteString)
-> [Path Abs File] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO ByteString
Data.ByteString.readFile (String -> IO ByteString)
-> (Path Abs File -> String) -> Path Abs File -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
Path.fromAbsFile) [Path Abs File]
absFiles
    [Path Rel File]
strippedFiles <- (Path Abs File -> IO (Path Rel File))
-> [Path Abs File] -> IO [Path Rel File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Path Abs Dir -> Path Abs File -> IO (Path Rel File)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
Path.stripProperPrefix Path Abs Dir
inputDir) [Path Abs File]
absFiles
    let GeneratedDocs [DocsGenWarning]
warnings [(Path Rel File, Text)]
docs = Text
-> CharacterSet
-> [(Path Rel File, ByteString)]
-> GeneratedDocs [(Path Rel File, Text)]
generateDocsPure Text
packageName CharacterSet
characterSet ([(Path Rel File, ByteString)]
 -> GeneratedDocs [(Path Rel File, Text)])
-> [(Path Rel File, ByteString)]
-> GeneratedDocs [(Path Rel File, Text)]
forall a b. (a -> b) -> a -> b
$ [Path Rel File] -> [ByteString] -> [(Path Rel File, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Path Rel File]
strippedFiles [ByteString]
contents
    (DocsGenWarning -> IO ()) -> [DocsGenWarning] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DocsGenWarning -> IO ()
forall a. Show a => a -> IO ()
print [DocsGenWarning]
warnings
    if [(Path Rel File, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Path Rel File, Text)]
docs then
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            String
"No documentation was generated because no file with .dhall " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
"extension was found"
    else String -> (Path Abs Dir -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (Path Abs Dir -> m a) -> m a
Path.IO.withSystemTempDir String
"dhall-docs" ((Path Abs Dir -> IO ()) -> IO ())
-> (Path Abs Dir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
tempDir -> do
        Path Abs Dir -> IO ()
copyDataDir Path Abs Dir
tempDir
        ((Path Rel File, Text) -> IO ())
-> [(Path Rel File, Text)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Path Abs Dir -> (Path Rel File, Text) -> IO ()
writeGenFile Path Abs Dir
tempDir) [(Path Rel File, Text)]
docs

        SHA256Digest
outputHash <- Path Abs Dir -> IO SHA256Digest
makeHashForDirectory Path Abs Dir
tempDir
        Path Abs Dir
outDir <- (Path Abs Dir -> Path Rel Dir -> Path Abs Dir)
-> IO (Path Abs Dir) -> IO (Path Rel Dir) -> IO (Path Abs Dir)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
(</>)
                    IO (Path Abs Dir)
getDocsHomeDirectory
                    (String -> IO (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
Path.parseRelDir
                        (String -> IO (Path Rel Dir)) -> String -> IO (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ SHA256Digest -> String
forall a. Show a => a -> String
show SHA256Digest
outputHash String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Data.Text.unpack Text
packageName)

        Path Abs Dir -> Path Abs Dir -> IO ()
forall (m :: * -> *) b0 b1.
(MonadIO m, MonadCatch m) =>
Path b0 Dir -> Path b1 Dir -> m ()
Path.IO.copyDirRecur Path Abs Dir
tempDir Path Abs Dir
outDir
        Path Abs Dir -> Path Abs Dir -> IO ()
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 Dir -> Path b1 Dir -> m ()
Path.IO.createDirLink Path Abs Dir
outDir Path Abs Dir
outLink
  where
    writeGenFile :: Path Abs Dir -> (Path Rel File, Text) -> IO ()
    writeGenFile :: Path Abs Dir -> (Path Rel File, Text) -> IO ()
writeGenFile Path Abs Dir
outDir (Path Rel File
relFile, Text
contents) = do
        Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
Path.IO.ensureDir (Path Abs Dir
outDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
Path.parent Path Rel File
relFile)
        String -> Text -> IO ()
Text.IO.writeFile (Path Abs File -> String
Path.fromAbsFile (Path Abs File -> String) -> Path Abs File -> String
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
outDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFile) Text
contents

    copyDataDir :: Path Abs Dir -> IO ()
    copyDataDir :: Path Abs Dir -> IO ()
copyDataDir Path Abs Dir
outDir = do
        [(Path Rel File, ByteString)]
dataDir <- IO [(Path Rel File, ByteString)]
getDataDir
        [(Path Rel File, ByteString)]
-> ((Path Rel File, ByteString) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Control.Monad.forM_ [(Path Rel File, ByteString)]
dataDir (((Path Rel File, ByteString) -> IO ()) -> IO ())
-> ((Path Rel File, ByteString) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Path Rel File
filename, ByteString
contents) -> do
            let finalPath :: String
finalPath = Path Abs File -> String
Path.fromAbsFile (Path Abs File -> String) -> Path Abs File -> String
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
outDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
filename
            String -> ByteString -> IO ()
Data.ByteString.writeFile String
finalPath ByteString
contents

{-| Generates all the documentation of dhall package in a pure way i.e.
    without an `IO` context. This let you generate documentation from a list of
    dhall-files without saving them to the filesystem.

    If you want the `IO` version of this function, check `generateDocs`
-}
generateDocsPure
    :: Text                    -- ^ Package name
    -> CharacterSet            -- ^ Output encoding
    -> [(Path Rel File, ByteString)] -- ^ (Input file, contents)
    -> GeneratedDocs [(Path Rel File, Text)]
generateDocsPure :: Text
-> CharacterSet
-> [(Path Rel File, ByteString)]
-> GeneratedDocs [(Path Rel File, Text)]
generateDocsPure Text
packageName CharacterSet
characterSet [(Path Rel File, ByteString)]
inputFiles = GeneratedDocs [(Path Rel File, Text)]
go
  where
    go :: GeneratedDocs [(Path Rel File, Text)]
    go :: GeneratedDocs [(Path Rel File, Text)]
go = do
        [DhallFile]
dhallFiles <- [(Path Rel File, ByteString)] -> GeneratedDocs [DhallFile]
getAllDhallFiles [(Path Rel File, ByteString)]
inputFiles
        [Text]
htmls <- (DhallFile -> GeneratedDocs Text)
-> [DhallFile] -> GeneratedDocs [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> CharacterSet -> DhallFile -> GeneratedDocs Text
makeHtml Text
packageName CharacterSet
characterSet) [DhallFile]
dhallFiles
        let indexes :: [(Path Rel File, Text)]
indexes = Text -> CharacterSet -> [DhallFile] -> [(Path Rel File, Text)]
createIndexes Text
packageName CharacterSet
characterSet [DhallFile]
dhallFiles
        [(Path Rel File, Text)] -> GeneratedDocs [(Path Rel File, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Path Rel File] -> [Text] -> [(Path Rel File, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((DhallFile -> Path Rel File) -> [DhallFile] -> [Path Rel File]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel File -> Path Rel File
addHtmlExt (Path Rel File -> Path Rel File)
-> (DhallFile -> Path Rel File) -> DhallFile -> Path Rel File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhallFile -> Path Rel File
path) [DhallFile]
dhallFiles) [Text]
htmls [(Path Rel File, Text)]
-> [(Path Rel File, Text)] -> [(Path Rel File, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Path Rel File, Text)]
indexes)