{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Dhall.Docs.Core
(
generateDocs
, generateDocsPure
, GeneratedDocs(..)
, 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
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
| (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: \"-- \""
newtype =
{ :: Maybe DhallDocsText
}
data DhallFile = DhallFile
{ DhallFile -> Path Rel File
path :: Path Rel File
, DhallFile -> Text
contents :: Text
, DhallFile -> Expr Src Import
expr :: Expr Src Import
, DhallFile -> Maybe (Expr Void Import)
mType :: Maybe (Expr Void Import)
, DhallFile -> [Expr Void Import]
examples :: [Expr Void Import]
, :: FileComments
}
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
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
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
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)
makeHtml
:: Text
-> CharacterSet
-> DhallFile
-> 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
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
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]
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 :: [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
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
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"
generateDocs
:: Path Abs Dir
-> Path Abs Dir
-> Text
-> CharacterSet
-> 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
generateDocsPure
:: Text
-> CharacterSet
-> [(Path Rel File, ByteString)]
-> 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)