-- | Display Drasil documentation nicely for the website.
module Drasil.Website.Documentation where

import Language.Drasil


-- * Haddock Documentation for Drasil Section

-- | Creates the Haddock documentation for all of Drasil.
docsSec :: FilePath -> Section
docsSec :: FilePath -> Section
docsSec path :: FilePath
path = 
  Sentence -> [Contents] -> [Section] -> Reference -> Section
section Sentence
haddockDocsTitle -- Title
  [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
haddockDocsDesc FilePath
path] -- Contents 
  [] (Reference -> Section) -> Reference -> Section
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence -> Reference
makeSecRef "Documentation" (Sentence -> Reference) -> Sentence -> Reference
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S "Documentation" -- Section Reference

-- | Haddock Documentation Section title.
haddockDocsTitle :: Sentence
haddockDocsTitle :: Sentence
haddockDocsTitle = FilePath -> Sentence
S "Haddock Documentation"

-- | Body paragraph that directs users to the Haddock documentation and a variant with fully exposed modules.
haddockDocsDesc :: FilePath -> Sentence
haddockDocsDesc :: FilePath -> Sentence
haddockDocsDesc path :: FilePath
path = FilePath -> Sentence
S "Drasil's framework is primariliy written in Haskell, \
  \so we use Haddock to document our code. The following link will take you \
  \to the current" Sentence -> Sentence -> Sentence
+:+ Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef (FilePath -> Reference
docsRef FilePath
path) (FilePath -> Sentence
S "Haddock documentation") 
  Sentence -> Sentence -> Sentence
+:+ FilePath -> Sentence
S "for the Drasil framework. A variant with"
  Sentence -> Sentence -> Sentence
+:+ Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef (FilePath -> Reference
fullDocsRef FilePath
path) (FilePath -> Sentence
S "fully exposed modules") Sentence -> Sentence -> Sentence
+:+ FilePath -> Sentence
S "is also available."

-- | Creates references to the haddock documentation (both normal and full variations).
docsRef, fullDocsRef :: FilePath -> Reference
docsRef :: FilePath -> Reference
docsRef path :: FilePath
path     = FilePath -> FilePath -> ShortName -> Reference
makeURI "haddockDocs" (FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "index.html") (ShortName -> Reference) -> ShortName -> Reference
forall a b. (a -> b) -> a -> b
$ Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S "HaddockDocs"
fullDocsRef :: FilePath -> Reference
fullDocsRef path :: FilePath
path = FilePath -> FilePath -> ShortName -> Reference
makeURI "fullHaddockDocs" (FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "full/index.html") (ShortName -> Reference) -> ShortName -> Reference
forall a b. (a -> b) -> a -> b
$ Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ FilePath -> Sentence
S "fullHaddockDocs"

-- | Gathers all references used in this file.
docRefs :: FilePath -> [Reference]
docRefs :: FilePath -> [Reference]
docRefs path :: FilePath
path = [FilePath -> Reference
docsRef FilePath
path, FilePath -> Reference
fullDocsRef FilePath
path]