{-# LANGUAGE OverloadedStrings, PatternGuards #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module Idris.IdrisDoc (generateDocs) where
import Idris.AbsSyntax
import Idris.Core.Evaluate (Accessibility(..), ctxtAlist, isDConName, isFnName,
isTConName, lookupDefAcc)
import Idris.Core.TT (Name(..), OutputAnnotation(..), TextFormatting(..),
constIsType, nsroot, sUN, str, toAlist, txt)
import Idris.Docs
import Idris.Docstrings (nullDocstring)
import qualified Idris.Docstrings as Docstrings
import Idris.Options
import Idris.Parser.Ops (opChars)
import IRTS.System (getIdrisDataFileByName)
import Control.Applicative ((<|>))
import Control.Monad (forM_)
import Control.Monad.Trans.Except
import Control.Monad.Trans.State.Strict
import qualified Data.ByteString.Lazy as BS2
import qualified Data.List as L
import qualified Data.Map as M hiding ((!))
import Data.Maybe
import qualified Data.Set as S
import qualified Data.Text as T
import System.Directory
import System.FilePath
import System.IO
import System.IO.Error
import Text.Blaze (contents, toValue)
import qualified Text.Blaze.Html.Renderer.String as R
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html5 (preEscapedToHtml, toHtml, (!))
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Text.Blaze.Renderer.String (renderMarkup)
import Text.PrettyPrint.Annotated.Leijen (displayDecorated, renderCompact)
generateDocs :: IState
-> [Name]
-> FilePath
-> IO (Either String ())
generateDocs :: IState -> [Name] -> FilePath -> IO (Either FilePath ())
generateDocs IState
ist [Name]
nss' FilePath
out =
do let nss :: [NsName]
nss = (Name -> NsName) -> [Name] -> [NsName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> NsName
toNsName [Name]
nss'
NsDict
docs <- IState -> [NsName] -> IO NsDict
fetchInfo IState
ist [NsName]
nss
let (Int
c, IO ()
io) = ((Int, IO ()) -> NsName -> (Int, IO ()))
-> (Int, IO ()) -> [NsName] -> (Int, IO ())
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (NsDict -> (Int, IO ()) -> NsName -> (Int, IO ())
forall a a.
Num a =>
Map NsName a -> (a, IO ()) -> NsName -> (a, IO ())
checker NsDict
docs) (Int
0, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) [NsName]
nss
IO ()
io
if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [NsName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NsName]
nss
then IO (Either FilePath ())
-> (IOError -> IO (Either FilePath ())) -> IO (Either FilePath ())
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (IState -> NsDict -> FilePath -> IO (Either FilePath ())
createDocs IState
ist NsDict
docs FilePath
out) (FilePath -> IO (Either FilePath ())
err (FilePath -> IO (Either FilePath ()))
-> (IOError -> FilePath) -> IOError -> IO (Either FilePath ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> FilePath
forall a. Show a => a -> FilePath
show)
else FilePath -> IO (Either FilePath ())
err FilePath
"No namespaces to generate documentation for"
where checker :: Map NsName a -> (a, IO ()) -> NsName -> (a, IO ())
checker Map NsName a
docs (a, IO ())
st NsName
ns | NsName -> Map NsName a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member NsName
ns Map NsName a
docs = (a, IO ())
st
checker Map NsName a
docs (a
c, IO ()
io) NsName
ns = (a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
1, do ()
prev <- IO ()
io; NsName -> IO ()
warnMissing NsName
ns)
warnMissing :: NsName -> IO ()
warnMissing NsName
ns =
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Warning: Ignoring empty or non-existing namespace '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
(NsName -> FilePath
nsName2Str NsName
ns) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
type Failable = Either String
type NsName = [T.Text]
type NsItem = (Name, Maybe Docs, Accessibility)
type FullDocstring = Docstrings.Docstring Docstrings.DocTerm
data NsInfo = NsInfo { NsInfo -> Maybe FullDocstring
nsDocstring :: Maybe FullDocstring,
NsInfo -> [NsItem]
nsContents :: [NsItem]
}
type NsDict = M.Map NsName NsInfo
err :: String -> IO (Failable ())
err :: FilePath -> IO (Either FilePath ())
err FilePath
s = Either FilePath () -> IO (Either FilePath ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath () -> IO (Either FilePath ()))
-> Either FilePath () -> IO (Either FilePath ())
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left FilePath
s
version :: String
version :: FilePath
version = FilePath
"1.0"
toNsName :: Name
-> NsName
toNsName :: Name -> NsName
toNsName (UN Text
n) = [Text
n]
toNsName (NS Name
n NsName
ns) = (Name -> NsName
toNsName Name
n) NsName -> NsName -> NsName
forall a. [a] -> [a] -> [a]
++ NsName
ns
toNsName Name
_ = []
getNs :: Name
-> NsName
getNs :: Name -> NsName
getNs (NS Name
_ NsName
ns) = NsName
ns
getNs Name
_ = []
rootNsStr :: String
rootNsStr :: FilePath
rootNsStr = FilePath
"[builtins]"
nsName2Str :: NsName
-> String
nsName2Str :: NsName -> FilePath
nsName2Str NsName
n = if NsName -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NsName
n then FilePath
rootNsStr else NsName -> FilePath
name NsName
n
where name :: NsName -> FilePath
name [] = []
name [Text
ns] = Text -> FilePath
str Text
ns
name (Text
ns:NsName
nss) = (NsName -> FilePath
name NsName
nss) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char
'.' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Text -> FilePath
str Text
ns)
fetchInfo :: IState
-> [NsName]
-> IO NsDict
fetchInfo :: IState -> [NsName] -> IO NsDict
fetchInfo IState
ist [NsName]
nss =
do let originNss :: Set NsName
originNss = [NsName] -> Set NsName
forall a. Ord a => [a] -> Set a
S.fromList [NsName]
nss
NsDict
info <- IState -> IO NsDict
nsDict IState
ist
let accessible :: NsDict
accessible = (NsInfo -> NsInfo) -> NsDict -> NsDict
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((NsItem -> Bool) -> NsInfo -> NsInfo
filterContents NsItem -> Bool
filterInclude) NsDict
info
nonOrphan :: NsDict
nonOrphan = (NsInfo -> NsInfo) -> NsDict -> NsDict
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (([NsItem] -> [NsItem]) -> NsInfo -> NsInfo
updateContents [NsItem] -> [NsItem]
removeOrphans) NsDict
accessible
nonEmpty :: NsDict
nonEmpty = (NsInfo -> Bool) -> NsDict -> NsDict
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not (Bool -> Bool) -> (NsInfo -> Bool) -> NsInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NsItem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([NsItem] -> Bool) -> (NsInfo -> [NsItem]) -> NsInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NsInfo -> [NsItem]
nsContents) NsDict
nonOrphan
reachedNss :: Set NsName
reachedNss = NsDict -> Set NsName -> Set NsName -> Set NsName
traceNss NsDict
nonEmpty Set NsName
originNss Set NsName
forall a. Set a
S.empty
NsDict -> IO NsDict
forall (m :: * -> *) a. Monad m => a -> m a
return (NsDict -> IO NsDict) -> NsDict -> IO NsDict
forall a b. (a -> b) -> a -> b
$ (NsName -> NsInfo -> Bool) -> NsDict -> NsDict
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\NsName
k NsInfo
_ -> NsName -> Set NsName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member NsName
k Set NsName
reachedNss) NsDict
nonEmpty
where
filterContents :: (NsItem -> Bool) -> NsInfo -> NsInfo
filterContents NsItem -> Bool
p (NsInfo Maybe FullDocstring
md [NsItem]
ns) = Maybe FullDocstring -> [NsItem] -> NsInfo
NsInfo Maybe FullDocstring
md ((NsItem -> Bool) -> [NsItem] -> [NsItem]
forall a. (a -> Bool) -> [a] -> [a]
filter NsItem -> Bool
p [NsItem]
ns)
updateContents :: ([NsItem] -> [NsItem]) -> NsInfo -> NsInfo
updateContents [NsItem] -> [NsItem]
f NsInfo
x = NsInfo
x { nsContents :: [NsItem]
nsContents = [NsItem] -> [NsItem]
f (NsInfo -> [NsItem]
nsContents NsInfo
x) }
removeOrphans :: [NsItem]
-> [NsItem]
removeOrphans :: [NsItem] -> [NsItem]
removeOrphans [NsItem]
list =
let children :: Set Name
children = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ (NsItem -> [Name]) -> [NsItem] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (Docs' FullDocstring) -> [Name]
forall d. Maybe (Docs' d) -> [Name]
names (Maybe (Docs' FullDocstring) -> [Name])
-> (NsItem -> Maybe (Docs' FullDocstring)) -> NsItem -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Name
_, Maybe (Docs' FullDocstring)
d, Accessibility
_) -> Maybe (Docs' FullDocstring)
d)) [NsItem]
list
in (NsItem -> Bool) -> [NsItem] -> [NsItem]
forall a. (a -> Bool) -> [a] -> [a]
filter (((Name -> Set Name -> Bool) -> Set Name -> Name -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember Set Name
children) (Name -> Bool) -> (NsItem -> Name) -> NsItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Name
n, Maybe (Docs' FullDocstring)
_, Accessibility
_) -> Name
n)) [NsItem]
list
where names :: Maybe (Docs' d) -> [Name]
names (Just (DataDoc FunDoc' d
_ [FunDoc' d]
fds)) = (FunDoc' d -> Name) -> [FunDoc' d] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\(FD Name
n d
_ [(Name, PTerm, Plicity, Maybe d)]
_ PTerm
_ Maybe Fixity
_) -> Name
n) [FunDoc' d]
fds
names (Just (InterfaceDoc Name
_ d
_ [FunDoc' d]
fds [(Name, Maybe d)]
_ [PTerm]
_ [(Maybe Name, PTerm, (d, [(Name, d)]))]
_ [PTerm]
_ [PTerm]
_ Maybe (FunDoc' d)
c)) = (FunDoc' d -> Name) -> [FunDoc' d] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\(FD Name
n d
_ [(Name, PTerm, Plicity, Maybe d)]
_ PTerm
_ Maybe Fixity
_) -> Name
n) [FunDoc' d]
fds [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FunDoc' d -> Name) -> [FunDoc' d] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\(FD Name
n d
_ [(Name, PTerm, Plicity, Maybe d)]
_ PTerm
_ Maybe Fixity
_) -> Name
n) (Maybe (FunDoc' d) -> [FunDoc' d]
forall a. Maybe a -> [a]
maybeToList Maybe (FunDoc' d)
c)
names Maybe (Docs' d)
_ = []
filterName :: Name
-> Bool
filterName :: Name -> Bool
filterName (UN Text
_) = Bool
True
filterName (NS Name
n NsName
_) = Name -> Bool
filterName Name
n
filterName Name
_ = Bool
False
filterInclude :: NsItem
-> Bool
filterInclude :: NsItem -> Bool
filterInclude (Name
name, Just Docs' FullDocstring
_, Accessibility
Public) | Name -> Bool
filterName Name
name = Bool
True
filterInclude (Name
name, Just Docs' FullDocstring
_, Accessibility
Frozen) | Name -> Bool
filterName Name
name = Bool
True
filterInclude NsItem
_ = Bool
False
traceNss :: NsDict
-> S.Set NsName
-> S.Set NsName
-> S.Set NsName
traceNss :: NsDict -> Set NsName -> Set NsName -> Set NsName
traceNss NsDict
nsd Set NsName
sT Set NsName
sD =
let nsTracer :: NsName -> [Set NsName]
nsTracer NsName
ns | Just NsInfo
nsis <- NsName -> NsDict -> Maybe NsInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup NsName
ns NsDict
nsd = (NsItem -> Set NsName) -> [NsItem] -> [Set NsName]
forall a b. (a -> b) -> [a] -> [b]
map NsItem -> Set NsName
referredNss (NsInfo -> [NsItem]
nsContents NsInfo
nsis)
nsTracer NsName
_ = [Set NsName
forall a. Set a
S.empty]
reached :: Set NsName
reached = [Set NsName] -> Set NsName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set NsName] -> Set NsName) -> [Set NsName] -> Set NsName
forall a b. (a -> b) -> a -> b
$ (NsName -> [Set NsName]) -> [NsName] -> [Set NsName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NsName -> [Set NsName]
nsTracer (Set NsName -> [NsName]
forall a. Set a -> [a]
S.toList Set NsName
sT)
processed :: Set NsName
processed = Set NsName -> Set NsName -> Set NsName
forall a. Ord a => Set a -> Set a -> Set a
S.union Set NsName
sT Set NsName
sD
untraced :: Set NsName
untraced = Set NsName -> Set NsName -> Set NsName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set NsName
reached Set NsName
processed
in if Set NsName -> Bool
forall a. Set a -> Bool
S.null Set NsName
untraced then Set NsName
processed
else NsDict -> Set NsName -> Set NsName -> Set NsName
traceNss NsDict
nsd Set NsName
untraced Set NsName
processed
referredNss :: NsItem
-> S.Set NsName
referredNss :: NsItem -> Set NsName
referredNss (Name
_, Maybe (Docs' FullDocstring)
Nothing, Accessibility
_) = Set NsName
forall a. Set a
S.empty
referredNss (Name
n, Just Docs' FullDocstring
d, Accessibility
_) =
let fds :: [FunDoc' FullDocstring]
fds = Docs' FullDocstring -> [FunDoc' FullDocstring]
forall d. Docs' d -> [FunDoc' d]
getFunDocs Docs' FullDocstring
d
ts :: [PTerm]
ts = (FunDoc' FullDocstring -> [PTerm])
-> [FunDoc' FullDocstring] -> [PTerm]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FunDoc' FullDocstring -> [PTerm]
forall d. FunDoc' d -> [PTerm]
types [FunDoc' FullDocstring]
fds
names :: [Name]
names = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PTerm -> [Name]
extractPTermNames) [PTerm]
ts
in (Name -> NsName) -> Set Name -> Set NsName
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Name -> NsName
getNs (Set Name -> Set NsName) -> Set Name -> Set NsName
forall a b. (a -> b) -> a -> b
$ [Name] -> Set Name
forall a. Ord a => [a] -> Set a
S.fromList [Name]
names
where getFunDocs :: Docs' d -> [FunDoc' d]
getFunDocs (FunDoc FunDoc' d
f) = [FunDoc' d
f]
getFunDocs (DataDoc FunDoc' d
f [FunDoc' d]
fs) = FunDoc' d
fFunDoc' d -> [FunDoc' d] -> [FunDoc' d]
forall a. a -> [a] -> [a]
:[FunDoc' d]
fs
getFunDocs (InterfaceDoc Name
_ d
_ [FunDoc' d]
fs [(Name, Maybe d)]
_ [PTerm]
_ [(Maybe Name, PTerm, (d, [(Name, d)]))]
_ [PTerm]
_ [PTerm]
_ Maybe (FunDoc' d)
_) = [FunDoc' d]
fs
getFunDocs (RecordDoc Name
_ d
_ FunDoc' d
f [FunDoc' d]
fs [(Name, PTerm, Maybe d)]
_) = FunDoc' d
fFunDoc' d -> [FunDoc' d] -> [FunDoc' d]
forall a. a -> [a] -> [a]
:[FunDoc' d]
fs
getFunDocs (NamedImplementationDoc Name
_ FunDoc' d
fd) = [FunDoc' d
fd]
getFunDocs (ModDoc [FilePath]
_ d
_) = []
types :: FunDoc' d -> [PTerm]
types (FD Name
_ d
_ [(Name, PTerm, Plicity, Maybe d)]
args PTerm
t Maybe Fixity
_) = PTerm
tPTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
:(((Name, PTerm, Plicity, Maybe d) -> PTerm)
-> [(Name, PTerm, Plicity, Maybe d)] -> [PTerm]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PTerm, Plicity, Maybe d) -> PTerm
forall a b c d. (a, b, c, d) -> b
second [(Name, PTerm, Plicity, Maybe d)]
args)
second :: (a, b, c, d) -> b
second (a
_, b
x, c
_, d
_) = b
x
nsDict :: IState
-> IO NsDict
nsDict :: IState -> IO NsDict
nsDict IState
ist = (IO NsDict -> [(Name, NsInfo)] -> IO NsDict)
-> [(Name, NsInfo)] -> IO NsDict -> IO NsDict
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((IO NsDict -> (Name, NsInfo) -> IO NsDict)
-> IO NsDict -> [(Name, NsInfo)] -> IO NsDict
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl IO NsDict -> (Name, NsInfo) -> IO NsDict
addModDoc) [(Name, NsInfo)]
modDocs (IO NsDict -> IO NsDict) -> IO NsDict -> IO NsDict
forall a b. (a -> b) -> a -> b
$ (IO NsDict -> (Name, Def) -> IO NsDict)
-> IO NsDict -> [(Name, Def)] -> IO NsDict
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl IO NsDict -> (Name, Def) -> IO NsDict
forall b. IO NsDict -> (Name, b) -> IO NsDict
adder (NsDict -> IO NsDict
forall (m :: * -> *) a. Monad m => a -> m a
return NsDict
forall k a. Map k a
M.empty) [(Name, Def)]
nameDefList
where nameDefList :: [(Name, Def)]
nameDefList = Context -> [(Name, Def)]
ctxtAlist (Context -> [(Name, Def)]) -> Context -> [(Name, Def)]
forall a b. (a -> b) -> a -> b
$ IState -> Context
tt_ctxt IState
ist
adder :: IO NsDict -> (Name, b) -> IO NsDict
adder IO NsDict
m (Name
n, b
_) = do NsDict
map <- IO NsDict
m
Maybe (Docs' FullDocstring)
doc <- IState -> Name -> IO (Maybe (Docs' FullDocstring))
loadDocs IState
ist Name
n
let access :: Accessibility
access = IState -> Name -> Accessibility
getAccess IState
ist Name
n
nInfo :: NsInfo
nInfo = Maybe FullDocstring -> [NsItem] -> NsInfo
NsInfo Maybe FullDocstring
forall a. Maybe a
Nothing [(Name
n, Maybe (Docs' FullDocstring)
doc, Accessibility
access)]
NsDict -> IO NsDict
forall (m :: * -> *) a. Monad m => a -> m a
return (NsDict -> IO NsDict) -> NsDict -> IO NsDict
forall a b. (a -> b) -> a -> b
$ (NsInfo -> NsInfo -> NsInfo)
-> NsName -> NsInfo -> NsDict -> NsDict
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith NsInfo -> NsInfo -> NsInfo
addNameInfo (Name -> NsName
getNs Name
n) NsInfo
nInfo NsDict
map
addNameInfo :: NsInfo -> NsInfo -> NsInfo
addNameInfo (NsInfo Maybe FullDocstring
m [NsItem]
ns) (NsInfo Maybe FullDocstring
m' [NsItem]
ns') = Maybe FullDocstring -> [NsItem] -> NsInfo
NsInfo (Maybe FullDocstring
m Maybe FullDocstring -> Maybe FullDocstring -> Maybe FullDocstring
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FullDocstring
m') ([NsItem]
ns [NsItem] -> [NsItem] -> [NsItem]
forall a. [a] -> [a] -> [a]
++ [NsItem]
ns')
modDocs :: [(Name, NsInfo)]
modDocs = ((Name, FullDocstring) -> (Name, NsInfo))
-> [(Name, FullDocstring)] -> [(Name, NsInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
mn, FullDocstring
d) -> (Name
mn, Maybe FullDocstring -> [NsItem] -> NsInfo
NsInfo (FullDocstring -> Maybe FullDocstring
forall a. a -> Maybe a
Just FullDocstring
d) [])) ([(Name, FullDocstring)] -> [(Name, NsInfo)])
-> [(Name, FullDocstring)] -> [(Name, NsInfo)]
forall a b. (a -> b) -> a -> b
$ Ctxt FullDocstring -> [(Name, FullDocstring)]
forall a. Ctxt a -> [(Name, a)]
toAlist (IState -> Ctxt FullDocstring
idris_moduledocs IState
ist)
addModDoc :: IO NsDict -> (Name, NsInfo) -> IO NsDict
addModDoc :: IO NsDict -> (Name, NsInfo) -> IO NsDict
addModDoc IO NsDict
dict (Name
mn, NsInfo
d) = (NsDict -> NsDict) -> IO NsDict -> IO NsDict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NsInfo -> NsInfo -> NsInfo)
-> NsName -> NsInfo -> NsDict -> NsDict
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith NsInfo -> NsInfo -> NsInfo
addNameInfo (Name -> NsName
getNs Name
mn) NsInfo
d) IO NsDict
dict
getAccess :: IState
-> Name
-> Accessibility
getAccess :: IState -> Name -> Accessibility
getAccess IState
ist Name
n =
let res :: [(Def, Accessibility)]
res = Name -> Bool -> Context -> [(Def, Accessibility)]
lookupDefAcc Name
n Bool
False (IState -> Context
tt_ctxt IState
ist)
in case [(Def, Accessibility)]
res of
[(Def
_, Accessibility
acc)] -> Accessibility
acc
[(Def, Accessibility)]
_ -> Accessibility
Private
mayHaveDocs :: Name
-> Bool
mayHaveDocs :: Name -> Bool
mayHaveDocs (UN Text
_) = Bool
True
mayHaveDocs (NS Name
n NsName
_) = Name -> Bool
mayHaveDocs Name
n
mayHaveDocs Name
_ = Bool
False
loadDocs :: IState
-> Name
-> IO (Maybe Docs)
loadDocs :: IState -> Name -> IO (Maybe (Docs' FullDocstring))
loadDocs IState
ist Name
n
| Name -> Bool
mayHaveDocs Name
n = do Either Err (Docs' FullDocstring)
docs <- ExceptT Err IO (Docs' FullDocstring)
-> IO (Either Err (Docs' FullDocstring))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Err IO (Docs' FullDocstring)
-> IO (Either Err (Docs' FullDocstring)))
-> ExceptT Err IO (Docs' FullDocstring)
-> IO (Either Err (Docs' FullDocstring))
forall a b. (a -> b) -> a -> b
$ StateT IState (ExceptT Err IO) (Docs' FullDocstring)
-> IState -> ExceptT Err IO (Docs' FullDocstring)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Name
-> HowMuchDocs
-> StateT IState (ExceptT Err IO) (Docs' FullDocstring)
getDocs Name
n HowMuchDocs
FullDocs) IState
ist
case Either Err (Docs' FullDocstring)
docs of Right Docs' FullDocstring
d -> Maybe (Docs' FullDocstring) -> IO (Maybe (Docs' FullDocstring))
forall (m :: * -> *) a. Monad m => a -> m a
return (Docs' FullDocstring -> Maybe (Docs' FullDocstring)
forall a. a -> Maybe a
Just Docs' FullDocstring
d)
Left Err
_ -> Maybe (Docs' FullDocstring) -> IO (Maybe (Docs' FullDocstring))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Docs' FullDocstring)
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe (Docs' FullDocstring) -> IO (Maybe (Docs' FullDocstring))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Docs' FullDocstring)
forall a. Maybe a
Nothing
extractPTermNames :: PTerm
-> [Name]
(PRef FC
_ [FC]
_ Name
n) = [Name
n]
extractPTermNames (PInferRef FC
_ [FC]
_ Name
n) = [Name
n]
extractPTermNames (PPatvar FC
_ Name
n) = [Name
n]
extractPTermNames (PLam FC
_ Name
n FC
_ PTerm
p1 PTerm
p2) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPTermNames (PPi Plicity
_ Name
n FC
_ PTerm
p1 PTerm
p2) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPTermNames (PLet FC
_ RigCount
_ Name
n FC
_ PTerm
p1 PTerm
p2 PTerm
p3) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2, PTerm
p3]
extractPTermNames (PTyped PTerm
p1 PTerm
p2) = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPTermNames (PApp FC
_ PTerm
p [PArg]
pas) = let names :: [Name]
names = (PArg -> [Name]) -> [PArg] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PArg -> [Name]
extractPArg [PArg]
pas
in (PTerm -> [Name]
extract PTerm
p) [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
names
extractPTermNames (PAppBind FC
_ PTerm
p [PArg]
pas) = let names :: [Name]
names = (PArg -> [Name]) -> [PArg] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PArg -> [Name]
extractPArg [PArg]
pas
in (PTerm -> [Name]
extract PTerm
p) [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
names
extractPTermNames (PMatchApp FC
_ Name
n) = [Name
n]
extractPTermNames (PCase FC
_ PTerm
p [(PTerm, PTerm)]
ps) = let ([PTerm]
ps1, [PTerm]
ps2) = [(PTerm, PTerm)] -> ([PTerm], [PTerm])
forall a b. [(a, b)] -> ([a], [b])
unzip [(PTerm, PTerm)]
ps
in (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract (PTerm
pPTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
:([PTerm]
ps1 [PTerm] -> [PTerm] -> [PTerm]
forall a. [a] -> [a] -> [a]
++ [PTerm]
ps2))
extractPTermNames (PIfThenElse FC
_ PTerm
c PTerm
t PTerm
f) = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
c, PTerm
t, PTerm
f]
extractPTermNames (PRewrite FC
_ Maybe Name
_ PTerm
a PTerm
b Maybe PTerm
m) | Just PTerm
c <- Maybe PTerm
m =
(PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
a, PTerm
b, PTerm
c]
extractPTermNames (PRewrite FC
_ Maybe Name
_ PTerm
a PTerm
b Maybe PTerm
_) = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
a, PTerm
b]
extractPTermNames (PPair FC
_ [FC]
_ PunInfo
_ PTerm
p1 PTerm
p2) = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPTermNames (PDPair FC
_ [FC]
_ PunInfo
_ PTerm
a PTerm
b PTerm
c) = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
a, PTerm
b, PTerm
c]
extractPTermNames (PAlternative [(Name, Name)]
_ PAltType
_ [PTerm]
l) = (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm]
l
extractPTermNames (PHidden PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTermNames (PGoal FC
_ PTerm
p1 Name
n PTerm
p2) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPTermNames (PDoBlock [PDo]
pdos) = (PDo -> [Name]) -> [PDo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PDo -> [Name]
extractPDo [PDo]
pdos
extractPTermNames (PIdiom FC
_ PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTermNames (PMetavar FC
_ Name
n) = [Name
n]
extractPTermNames (PProof [PTactic]
tacts) = (PTactic -> [Name]) -> [PTactic] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTactic -> [Name]
extractPTactic [PTactic]
tacts
extractPTermNames (PTactics [PTactic]
tacts) = (PTactic -> [Name]) -> [PTactic] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTactic -> [Name]
extractPTactic [PTactic]
tacts
extractPTermNames (PCoerced PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTermNames (PDisamb [NsName]
_ PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTermNames (PUnifyLog PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTermNames (PNoImplicits PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTermNames (PRunElab FC
_ PTerm
p [FilePath]
_) = PTerm -> [Name]
extract PTerm
p
extractPTermNames (PConstSugar FC
_ PTerm
tm) = PTerm -> [Name]
extract PTerm
tm
extractPTermNames PTerm
_ = []
extract :: PTerm
-> [Name]
= PTerm -> [Name]
extractPTermNames
extractPArg :: PArg -> [Name]
(PImp {pname :: forall t. PArg' t -> Name
pname=Name
n, getTm :: forall t. PArg' t -> t
getTm=PTerm
p}) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: PTerm -> [Name]
extract PTerm
p
extractPArg (PExp {getTm :: forall t. PArg' t -> t
getTm=PTerm
p}) = PTerm -> [Name]
extract PTerm
p
extractPArg (PConstraint {getTm :: forall t. PArg' t -> t
getTm=PTerm
p}) = PTerm -> [Name]
extract PTerm
p
extractPArg (PTacImplicit {pname :: forall t. PArg' t -> Name
pname=Name
n, getScript :: forall t. PArg' t -> t
getScript=PTerm
p1, getTm :: forall t. PArg' t -> t
getTm=PTerm
p2})
= Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ((PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2])
extractPDo :: PDo -> [Name]
(DoExp FC
_ PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPDo (DoBind FC
_ Name
n FC
_ PTerm
p) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: PTerm -> [Name]
extract PTerm
p
extractPDo (DoBindP FC
_ PTerm
p1 PTerm
p2 [(PTerm, PTerm)]
ps) = let ([PTerm]
ps1, [PTerm]
ps2) = [(PTerm, PTerm)] -> ([PTerm], [PTerm])
forall a b. [(a, b)] -> ([a], [b])
unzip [(PTerm, PTerm)]
ps
ps' :: [PTerm]
ps' = [PTerm]
ps1 [PTerm] -> [PTerm] -> [PTerm]
forall a. [a] -> [a] -> [a]
++ [PTerm]
ps2
in (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract (PTerm
p1 PTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
: PTerm
p2 PTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
: [PTerm]
ps')
extractPDo (DoLet FC
_ RigCount
_ Name
n FC
_ PTerm
p1 PTerm
p2) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPDo (DoLetP FC
_ PTerm
p1 PTerm
p2 [(PTerm, PTerm)]
ps) = let ([PTerm]
ps1, [PTerm]
ps2) = [(PTerm, PTerm)] -> ([PTerm], [PTerm])
forall a b. [(a, b)] -> ([a], [b])
unzip [(PTerm, PTerm)]
ps
ps' :: [PTerm]
ps' = [PTerm]
ps1 [PTerm] -> [PTerm] -> [PTerm]
forall a. [a] -> [a] -> [a]
++ [PTerm]
ps2
in (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract (PTerm
p1 PTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
: PTerm
p2 PTerm -> [PTerm] -> [PTerm]
forall a. a -> [a] -> [a]
: [PTerm]
ps')
extractPDo (DoRewrite FC
_ PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic :: PTactic -> [Name]
(Intro [Name]
ns) = [Name]
ns
extractPTactic (Focus Name
n) = [Name
n]
extractPTactic (Refine Name
n [Bool]
_) = [Name
n]
extractPTactic (Rewrite PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (Equiv PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (MatchRefine Name
n) = [Name
n]
extractPTactic (LetTac Name
n PTerm
p) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: PTerm -> [Name]
extract PTerm
p
extractPTactic (LetTacTy Name
n PTerm
p1 PTerm
p2) = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (PTerm -> [Name]) -> [PTerm] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPTactic (Exact PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (ProofSearch Bool
_ Bool
_ Int
_ Maybe Name
m [Name]
_ [Name]
ns) | Just Name
n <- Maybe Name
m = Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ns
extractPTactic (ProofSearch Bool
_ Bool
_ Int
_ Maybe Name
_ [Name]
_ [Name]
ns) = [Name]
ns
extractPTactic (Try PTactic
t1 PTactic
t2) = (PTactic -> [Name]) -> [PTactic] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTactic -> [Name]
extractPTactic [PTactic
t1, PTactic
t2]
extractPTactic (TSeq PTactic
t1 PTactic
t2) = (PTactic -> [Name]) -> [PTactic] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTactic -> [Name]
extractPTactic [PTactic
t1, PTactic
t2]
extractPTactic (ApplyTactic PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (ByReflection PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (Reflect PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (Fill PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (GoalType FilePath
_ PTactic
t) = PTactic -> [Name]
extractPTactic PTactic
t
extractPTactic (TCheck PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic (TEval PTerm
p) = PTerm -> [Name]
extract PTerm
p
extractPTactic PTactic
_ = []
createDocs :: IState
-> NsDict
-> FilePath
-> IO (Failable ())
createDocs :: IState -> NsDict -> FilePath -> IO (Either FilePath ())
createDocs IState
ist NsDict
nsd FilePath
out =
do Bool
new <- Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
out FilePath -> FilePath -> FilePath
</> FilePath
"IdrisDoc")
Set NsName
existing_nss <- FilePath -> IO (Set NsName)
existingNamespaces FilePath
out
let nss :: Set NsName
nss = Set NsName -> Set NsName -> Set NsName
forall a. Ord a => Set a -> Set a -> Set a
S.union (NsDict -> Set NsName
forall k a. Map k a -> Set k
M.keysSet NsDict
nsd) Set NsName
existing_nss
Bool
dExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
out
if Bool
new Bool -> Bool -> Bool
&& Bool
dExists then FilePath -> IO (Either FilePath ())
err (FilePath -> IO (Either FilePath ()))
-> FilePath -> IO (Either FilePath ())
forall a b. (a -> b) -> a -> b
$ FilePath
"Output directory (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
out FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
") is" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" already in use for other than IdrisDoc."
else do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
out
(IO () -> (NsName, NsInfo) -> IO ())
-> IO () -> [(NsName, NsInfo)] -> IO ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl IO () -> (NsName, NsInfo) -> IO ()
forall a. IO a -> (NsName, NsInfo) -> IO ()
docGen (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (NsDict -> [(NsName, NsInfo)]
forall k a. Map k a -> [(k, a)]
M.toList NsDict
nsd)
Set NsName -> FilePath -> IO ()
createIndex Set NsName
nss FilePath
out
if Bool
new
then FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (FilePath
out FilePath -> FilePath -> FilePath
</> FilePath
"IdrisDoc") IOMode
WriteMode (((Handle -> FilePath -> IO ()) -> FilePath -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> FilePath -> IO ()
hPutStr) FilePath
"")
else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FilePath -> IO ()
copyDependencies FilePath
out
Either FilePath () -> IO (Either FilePath ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath () -> IO (Either FilePath ()))
-> Either FilePath () -> IO (Either FilePath ())
forall a b. (a -> b) -> a -> b
$ () -> Either FilePath ()
forall a b. b -> Either a b
Right ()
where docGen :: IO a -> (NsName, NsInfo) -> IO ()
docGen IO a
io (NsName
n, NsInfo
c) = do IO a
io; IState -> NsName -> NsInfo -> FilePath -> IO ()
createNsDoc IState
ist NsName
n NsInfo
c FilePath
out
createIndex :: S.Set NsName
-> FilePath
-> IO ()
createIndex :: Set NsName -> FilePath -> IO ()
createIndex Set NsName
nss FilePath
out =
do (FilePath
path, Handle
h) <- FilePath -> FilePath -> IO (FilePath, Handle)
openTempFileWithDefaultPermissions FilePath
out FilePath
"index.html"
Handle -> ByteString -> IO ()
BS2.hPut Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Html -> ByteString
renderHtml (Html -> ByteString) -> Html -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe NsName -> Html -> Html
wrapper Maybe NsName
forall a. Maybe a
Nothing (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.h1 Html
"Namespaces"
Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"names" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
let path :: NsName -> FilePath
path NsName
ns = FilePath
"docs" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NsName -> FilePath -> FilePath
genRelNsPath NsName
ns FilePath
"html"
item :: NsName -> Html
item NsName
ns = do let n :: Html
n = FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ NsName -> FilePath
nsName2Str NsName
ns
link :: AttributeValue
link = FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ NsName -> FilePath
path NsName
ns
Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
link (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"code" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
n
sort :: [NsName] -> [NsName]
sort = (NsName -> NsName -> Ordering) -> [NsName] -> [NsName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\NsName
n1 NsName
n2 -> NsName -> NsName
forall a. [a] -> [a]
reverse NsName
n1 NsName -> NsName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` NsName -> NsName
forall a. [a] -> [a]
reverse NsName
n2)
[NsName] -> (NsName -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([NsName] -> [NsName]
sort ([NsName] -> [NsName]) -> [NsName] -> [NsName]
forall a b. (a -> b) -> a -> b
$ Set NsName -> [NsName]
forall a. Set a -> [a]
S.toList Set NsName
nss) NsName -> Html
item
Handle -> IO ()
hClose Handle
h
FilePath -> FilePath -> IO ()
renameFile FilePath
path (FilePath
out FilePath -> FilePath -> FilePath
</> FilePath
"index.html")
createNsDoc :: IState
-> NsName
-> NsInfo
-> FilePath
-> IO ()
createNsDoc :: IState -> NsName -> NsInfo -> FilePath -> IO ()
createNsDoc IState
ist NsName
ns NsInfo
content FilePath
out =
do let tpath :: FilePath
tpath = FilePath
out FilePath -> FilePath -> FilePath
</> FilePath
"docs" FilePath -> FilePath -> FilePath
</> (NsName -> FilePath -> FilePath
genRelNsPath NsName
ns FilePath
"html")
dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
tpath
file :: FilePath
file = FilePath -> FilePath
takeFileName FilePath
tpath
haveDocs :: (a, b, c) -> b
haveDocs (a
_, b
md, c
_) = b
md
content' :: [Docs' FullDocstring]
content' = [Docs' FullDocstring] -> [Docs' FullDocstring]
forall a. [a] -> [a]
reverse ([Docs' FullDocstring] -> [Docs' FullDocstring])
-> [Docs' FullDocstring] -> [Docs' FullDocstring]
forall a b. (a -> b) -> a -> b
$ (NsItem -> Maybe (Docs' FullDocstring))
-> [NsItem] -> [Docs' FullDocstring]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NsItem -> Maybe (Docs' FullDocstring)
forall a b c. (a, b, c) -> b
haveDocs ([NsItem] -> [Docs' FullDocstring])
-> [NsItem] -> [Docs' FullDocstring]
forall a b. (a -> b) -> a -> b
$ NsInfo -> [NsItem]
nsContents NsInfo
content
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
(FilePath
path, Handle
h) <- FilePath -> FilePath -> IO (FilePath, Handle)
openTempFileWithDefaultPermissions FilePath
dir FilePath
file
Handle -> ByteString -> IO ()
BS2.hPut Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Html -> ByteString
renderHtml (Html -> ByteString) -> Html -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe NsName -> Html -> Html
wrapper (NsName -> Maybe NsName
forall a. a -> Maybe a
Just NsName
ns) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.h1 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (NsName -> FilePath
nsName2Str NsName
ns)
case NsInfo -> Maybe FullDocstring
nsDocstring NsInfo
content of
Maybe FullDocstring
Nothing -> Html
forall a. Monoid a => a
mempty
Just FullDocstring
docstring -> FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring
Html -> Html
H.dl (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Docs' FullDocstring] -> (Docs' FullDocstring -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Docs' FullDocstring]
content' (IState -> Docs' FullDocstring -> Html
createOtherDoc IState
ist)
Handle -> IO ()
hClose Handle
h
FilePath -> FilePath -> IO ()
renameFile FilePath
path FilePath
tpath
genRelNsPath :: NsName
-> String
-> FilePath
genRelNsPath :: NsName -> FilePath -> FilePath
genRelNsPath NsName
ns FilePath
suffix = NsName -> FilePath
nsName2Str NsName
ns FilePath -> FilePath -> FilePath
<.> FilePath
suffix
genTypeHeader :: IState
-> FunDoc
-> H.Html
IState
ist (FD Name
n FullDocstring
_ [(Name, PTerm, Plicity, Maybe FullDocstring)]
args PTerm
ftype Maybe Fixity
_) = do
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ FilePath
"name " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
getType Name
n)
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
name (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> Name
nsroot Name
n
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do Html
nbsp; Html
":"; Html
nbsp
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"signature" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml FilePath
htmlSignature
where
htmlSignature :: FilePath
htmlSignature = (OutputAnnotation -> FilePath -> FilePath)
-> SimpleDoc OutputAnnotation -> FilePath
forall a. (a -> FilePath -> FilePath) -> SimpleDoc a -> FilePath
displayDecorated OutputAnnotation -> FilePath -> FilePath
decorator (SimpleDoc OutputAnnotation -> FilePath)
-> SimpleDoc OutputAnnotation -> FilePath
forall a b. (a -> b) -> a -> b
$ Doc OutputAnnotation -> SimpleDoc OutputAnnotation
forall a. Doc a -> SimpleDoc a
renderCompact Doc OutputAnnotation
signature
signature :: Doc OutputAnnotation
signature = PPOption
-> [(Name, Bool)]
-> [Name]
-> [FixDecl]
-> PTerm
-> Doc OutputAnnotation
pprintPTerm PPOption
defaultPPOption [] [Name]
names (IState -> [FixDecl]
idris_infixes IState
ist) PTerm
ftype
names :: [Name]
names = [ Name
n | (n :: Name
n@(UN Text
n'), PTerm
_, Plicity
_, Maybe FullDocstring
_) <- [(Name, PTerm, Plicity, Maybe FullDocstring)]
args,
Bool -> Bool
not (Text -> Text -> Bool
T.isPrefixOf (FilePath -> Text
txt FilePath
"__") Text
n') ]
decorator :: OutputAnnotation -> FilePath -> FilePath
decorator (AnnConst Const
c) FilePath
str | Const -> Bool
constIsType Const
c = FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
str FilePath
"type" FilePath
str
| Bool
otherwise = FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
str FilePath
"data" FilePath
str
decorator (AnnData FilePath
_ FilePath
_) FilePath
str = FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
str FilePath
"data" FilePath
str
decorator (AnnType FilePath
_ FilePath
_) FilePath
str = FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
str FilePath
"type" FilePath
str
decorator OutputAnnotation
AnnKeyword FilePath
str = FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
"" FilePath
"keyword" FilePath
str
decorator (AnnBoundName Name
n Bool
i) FilePath
str | Just FilePath
t <- Name -> Map Name FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n Map Name FilePath
docs =
let cs :: FilePath
cs = (if Bool
i then FilePath
"implicit " else FilePath
"") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"documented boundvar"
in FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
t FilePath
cs FilePath
str
decorator (AnnBoundName Name
_ Bool
i) FilePath
str =
let cs :: FilePath
cs = (if Bool
i then FilePath
"implicit " else FilePath
"") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"boundvar"
in FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
"" FilePath
cs FilePath
str
decorator (AnnName Name
n Maybe NameOutput
_ Maybe FilePath
_ Maybe FilePath
_) FilePath
str
| Name -> Bool
filterName Name
n = FilePath -> FilePath -> FilePath -> FilePath -> FilePath
htmlLink (Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n) (Name -> FilePath
getType Name
n) (Name -> FilePath
link Name
n) FilePath
str
| Bool
otherwise = FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
"" (Name -> FilePath
getType Name
n) FilePath
str
decorator (AnnTextFmt TextFormatting
BoldText) FilePath
str = FilePath
"<b>" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
str FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"</b>"
decorator (AnnTextFmt TextFormatting
UnderlineText) FilePath
str = FilePath
"<u>" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
str FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"</u>"
decorator (AnnTextFmt TextFormatting
ItalicText) FilePath
str = FilePath
"<i>" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
str FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"</i>"
decorator OutputAnnotation
_ FilePath
str = FilePath
str
htmlSpan :: String -> String -> String -> String
htmlSpan :: FilePath -> FilePath -> FilePath -> FilePath
htmlSpan FilePath
t FilePath
cs FilePath
str = do
Html -> FilePath
R.renderHtml (Html -> FilePath) -> Html -> FilePath
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FilePath
cs)
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FilePath
t)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml FilePath
str
htmlLink :: String -> String -> String -> String -> String
htmlLink :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
htmlLink FilePath
t FilePath
cs FilePath
a FilePath
str = do
Html -> FilePath
R.renderHtml (Html -> FilePath) -> Html -> FilePath
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FilePath
cs)
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FilePath
t) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FilePath
a)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml FilePath
str
docs :: Map Name FilePath
docs = [(Name, FilePath)] -> Map Name FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FilePath)] -> Map Name FilePath)
-> [(Name, FilePath)] -> Map Name FilePath
forall a b. (a -> b) -> a -> b
$ ((Name, PTerm, Plicity, Maybe FullDocstring)
-> Maybe (Name, FilePath))
-> [(Name, PTerm, Plicity, Maybe FullDocstring)]
-> [(Name, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name, PTerm, Plicity, Maybe FullDocstring)
-> Maybe (Name, FilePath)
forall a b c. (a, b, c, Maybe FullDocstring) -> Maybe (a, FilePath)
docExtractor [(Name, PTerm, Plicity, Maybe FullDocstring)]
args
docExtractor :: (a, b, c, Maybe FullDocstring) -> Maybe (a, FilePath)
docExtractor (a
_, b
_, c
_, Maybe FullDocstring
Nothing) = Maybe (a, FilePath)
forall a. Maybe a
Nothing
docExtractor (a
n, b
_, c
_, Just FullDocstring
d) = (a, FilePath) -> Maybe (a, FilePath)
forall a. a -> Maybe a
Just (a
n, FullDocstring -> FilePath
doc2Str FullDocstring
d)
doc2Str :: FullDocstring -> FilePath
doc2Str FullDocstring
d = let dirty :: FilePath
dirty = Html -> FilePath
renderMarkup (Html -> FilePath) -> Html -> FilePath
forall a b. (a -> b) -> a -> b
$ Html -> Html
forall a. MarkupM a -> MarkupM a
contents (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FullDocstring -> Html
Docstrings.renderHtml FullDocstring
d
in Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
dirty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
3 FilePath
dirty
name :: Name -> FilePath
name (NS Name
n NsName
ns) = Name -> FilePath
forall a. Show a => a -> FilePath
show (Name -> NsName -> Name
NS (FilePath -> Name
sUN (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
name Name
n) NsName
ns)
name Name
n = let n' :: FilePath
n' = Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n
in if (FilePath -> Char
forall a. [a] -> a
head FilePath
n') Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
opChars
then Char
'('Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:(FilePath
n' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")")
else FilePath
n'
link :: Name -> FilePath
link Name
n = let path :: FilePath
path = NsName -> FilePath -> FilePath
genRelNsPath (Name -> NsName
getNs Name
n) FilePath
"html"
in FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"#" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n)
getType :: Name -> String
getType :: Name -> FilePath
getType Name
n = let ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
ist
in case () of
()
_ | Name -> Context -> Bool
isDConName Name
n Context
ctxt -> FilePath
"constructor"
()
_ | Name -> Context -> Bool
isFnName Name
n Context
ctxt -> FilePath
"function"
()
_ | Name -> Context -> Bool
isTConName Name
n Context
ctxt -> FilePath
"type"
()
_ | Bool
otherwise -> FilePath
""
createFunDoc :: IState
-> FunDoc
-> H.Html
createFunDoc :: IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist fd :: FunDoc' FullDocstring
fd@(FD Name
name FullDocstring
docstring [(Name, PTerm, Plicity, Maybe FullDocstring)]
args PTerm
ftype Maybe Fixity
fixity) = do
Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
name) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ IState -> FunDoc' FullDocstring -> Html
genTypeHeader IState
ist FunDoc' FullDocstring
fd
Html -> Html
H.dd (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
(if FullDocstring -> Bool
forall a. Docstring a -> Bool
nullDocstring FullDocstring
docstring then Html
forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring)
let args' :: [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' = ((Name, PTerm, Plicity, Maybe FullDocstring) -> Bool)
-> [(Name, PTerm, Plicity, Maybe FullDocstring)]
-> [(Name, PTerm, Plicity, Maybe FullDocstring)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
_, PTerm
_, Plicity
_, Maybe FullDocstring
d) -> Maybe FullDocstring -> Bool
forall a. Maybe a -> Bool
isJust Maybe FullDocstring
d) [(Name, PTerm, Plicity, Maybe FullDocstring)]
args
if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Name, PTerm, Plicity, Maybe FullDocstring)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, PTerm, Plicity, Maybe FullDocstring)]
args') Bool -> Bool -> Bool
|| (Maybe Fixity -> Bool
forall a. Maybe a -> Bool
isJust Maybe Fixity
fixity)
then Html -> Html
H.dl (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
if (Maybe Fixity -> Bool
forall a. Maybe a -> Bool
isJust Maybe Fixity
fixity) then do
Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"fixity" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Fixity"
let f :: Fixity
f = Maybe Fixity -> Fixity
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Fixity
fixity
Html -> Html
H.dd (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"fixity" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Fixity -> FilePath
forall a. Show a => a -> FilePath
show Fixity
f) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Fixity -> Html
genFix Fixity
f
else Html
forall a. Monoid a => a
mempty
[(Name, PTerm, Plicity, Maybe FullDocstring)]
-> ((Name, PTerm, Plicity, Maybe FullDocstring) -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' (Name, PTerm, Plicity, Maybe FullDocstring) -> Html
forall a b c. Show a => (a, b, c, Maybe FullDocstring) -> Html
genArg
else Html
forall a. Monoid a => a
mempty
where genFix :: Fixity -> Html
genFix (Infixl {prec :: Fixity -> Int
prec=Int
p}) =
FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ FilePath
"Left associative, precedence " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
p
genFix (Infixr {prec :: Fixity -> Int
prec=Int
p}) =
FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ FilePath
"Left associative, precedence " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
p
genFix (InfixN {prec :: Fixity -> Int
prec=Int
p}) =
FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ FilePath
"Non-associative, precedence " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
p
genFix (PrefixN {prec :: Fixity -> Int
prec=Int
p}) =
FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ FilePath
"Prefix, precedence " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
p
genArg :: (a, b, c, Maybe FullDocstring) -> Html
genArg (a
_, b
_, c
_, Maybe FullDocstring
Nothing) = Html
forall a. Monoid a => a
mempty
genArg (a
name, b
_, c
_, Just FullDocstring
docstring) = do
Html -> Html
H.dt (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall a. Show a => a -> FilePath
show a
name
Html -> Html
H.dd (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring
createOtherDoc :: IState
-> Docs
-> H.Html
createOtherDoc :: IState -> Docs' FullDocstring -> Html
createOtherDoc IState
ist (FunDoc FunDoc' FullDocstring
fd) = IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist FunDoc' FullDocstring
fd
createOtherDoc IState
ist (InterfaceDoc Name
n FullDocstring
docstring [FunDoc' FullDocstring]
fds [(Name, Maybe FullDocstring)]
_ [PTerm]
_ [(Maybe Name, PTerm, (FullDocstring, [(Name, FullDocstring)]))]
_ [PTerm]
_ [PTerm]
_ Maybe (FunDoc' FullDocstring)
c) = do
Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do Html
"interface"; Html
nbsp
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"name type"
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
name (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> Name
nsroot Name
n
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"signature" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
nbsp
Html -> Html
H.dd (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
(if FullDocstring -> Bool
forall a. Docstring a -> Bool
nullDocstring FullDocstring
docstring then Html
forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring)
Html -> Html
H.dl (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ ([FunDoc' FullDocstring] -> (FunDoc' FullDocstring -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe (FunDoc' FullDocstring) -> [FunDoc' FullDocstring]
forall a. Maybe a -> [a]
maybeToList Maybe (FunDoc' FullDocstring)
c [FunDoc' FullDocstring]
-> [FunDoc' FullDocstring] -> [FunDoc' FullDocstring]
forall a. [a] -> [a] -> [a]
++ [FunDoc' FullDocstring]
fds) (IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist))
where name :: Name -> FilePath
name (NS Name
n NsName
ns) = Name -> FilePath
forall a. Show a => a -> FilePath
show (Name -> NsName -> Name
NS (FilePath -> Name
sUN (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
name Name
n) NsName
ns)
name Name
n = let n' :: FilePath
n' = Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n
in if (FilePath -> Char
forall a. [a] -> a
head FilePath
n') Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
opChars
then Char
'('Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:(FilePath
n' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")")
else FilePath
n'
createOtherDoc IState
ist (RecordDoc Name
n FullDocstring
doc FunDoc' FullDocstring
ctor [FunDoc' FullDocstring]
projs [(Name, PTerm, Maybe FullDocstring)]
params) = do
Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do Html
"record"; Html
nbsp
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"name type"
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
name (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> Name
nsroot Name
n
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"type" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do Html
nbsp ; Html
prettyParameters
Html -> Html
H.dd (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
(if FullDocstring -> Bool
forall a. Docstring a -> Bool
nullDocstring FullDocstring
doc then Html
forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
doc)
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Name, PTerm, Maybe FullDocstring)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, PTerm, Maybe FullDocstring)]
params
then Html -> Html
H.dl (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [(Name, PTerm, Maybe FullDocstring)]
-> ((Name, PTerm, Maybe FullDocstring) -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, PTerm, Maybe FullDocstring)]
params (Name, PTerm, Maybe FullDocstring) -> Html
forall b. (Name, b, Maybe FullDocstring) -> Html
genParam
else Html
forall a. Monoid a => a
mempty
Html -> Html
H.dl (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist FunDoc' FullDocstring
ctor
Html -> Html
H.dl (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [FunDoc' FullDocstring] -> (FunDoc' FullDocstring -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FunDoc' FullDocstring]
projs (IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist)
where name :: Name -> FilePath
name (NS Name
n NsName
ns) = Name -> FilePath
forall a. Show a => a -> FilePath
show (Name -> NsName -> Name
NS (FilePath -> Name
sUN (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
name Name
n) NsName
ns)
name Name
n = let n' :: FilePath
n' = Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n
in if (FilePath -> Char
forall a. [a] -> a
head FilePath
n') Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
opChars
then Char
'('Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:(FilePath
n' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")")
else FilePath
n'
genParam :: (Name, b, Maybe FullDocstring) -> Html
genParam (Name
name, b
pt, Maybe FullDocstring
docstring) = do
Html -> Html
H.dt (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show (Name -> Name
nsroot Name
name)
Html -> Html
H.dd (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> (FullDocstring -> Html) -> Maybe FullDocstring -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
nbsp FullDocstring -> Html
Docstrings.renderHtml Maybe FullDocstring
docstring
prettyParameters :: Html
prettyParameters = FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [Name -> FilePath
forall a. Show a => a -> FilePath
show (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> Name
nsroot Name
n | (Name
n,PTerm
_,Maybe FullDocstring
_) <- [(Name, PTerm, Maybe FullDocstring)]
params]
createOtherDoc IState
ist (DataDoc fd :: FunDoc' FullDocstring
fd@(FD Name
n FullDocstring
docstring [(Name, PTerm, Plicity, Maybe FullDocstring)]
args PTerm
_ Maybe Fixity
_) [FunDoc' FullDocstring]
fds) = do
Html -> Html
H.dt (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
n) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do Html
"data"; Html
nbsp
IState -> FunDoc' FullDocstring -> Html
genTypeHeader IState
ist FunDoc' FullDocstring
fd
Html -> Html
H.dd (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
(if FullDocstring -> Bool
forall a. Docstring a -> Bool
nullDocstring FullDocstring
docstring then Html
forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring)
let args' :: [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' = ((Name, PTerm, Plicity, Maybe FullDocstring) -> Bool)
-> [(Name, PTerm, Plicity, Maybe FullDocstring)]
-> [(Name, PTerm, Plicity, Maybe FullDocstring)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
_, PTerm
_, Plicity
_, Maybe FullDocstring
d) -> Maybe FullDocstring -> Bool
forall a. Maybe a -> Bool
isJust Maybe FullDocstring
d) [(Name, PTerm, Plicity, Maybe FullDocstring)]
args
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Name, PTerm, Plicity, Maybe FullDocstring)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, PTerm, Plicity, Maybe FullDocstring)]
args'
then Html -> Html
H.dl (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [(Name, PTerm, Plicity, Maybe FullDocstring)]
-> ((Name, PTerm, Plicity, Maybe FullDocstring) -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' (Name, PTerm, Plicity, Maybe FullDocstring) -> Html
forall a b c. Show a => (a, b, c, Maybe FullDocstring) -> Html
genArg
else Html
forall a. Monoid a => a
mempty
Html -> Html
H.dl (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [FunDoc' FullDocstring] -> (FunDoc' FullDocstring -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FunDoc' FullDocstring]
fds (IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist)
where genArg :: (a, b, c, Maybe FullDocstring) -> Html
genArg (a
_, b
_, c
_, Maybe FullDocstring
Nothing) = Html
forall a. Monoid a => a
mempty
genArg (a
name, b
_, c
_, Just FullDocstring
docstring) = do
Html -> Html
H.dt (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml (FilePath -> Html) -> FilePath -> Html
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall a. Show a => a -> FilePath
show a
name
Html -> Html
H.dd (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring
createOtherDoc IState
ist (NamedImplementationDoc Name
_ FunDoc' FullDocstring
fd) = IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist FunDoc' FullDocstring
fd
createOtherDoc IState
ist (ModDoc [FilePath]
_ FullDocstring
docstring) = do
FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring
wrapper :: Maybe NsName
-> H.Html
-> H.Html
wrapper :: Maybe NsName -> Html -> Html
wrapper Maybe NsName
ns Html
inner =
let (Bool
index, FilePath
str) = Maybe NsName -> (Bool, FilePath)
extract Maybe NsName
ns
base :: FilePath
base = if Bool
index then FilePath
"" else FilePath
"../"
styles :: FilePath
styles = FilePath
base FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"styles.css" :: String
indexPage :: FilePath
indexPage = FilePath
base FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"index.html" :: String
in Html -> Html
H.docTypeHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"utf-8"
Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"viewport" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
content AttributeValue
"width=device-width, initial-scale=1, shrink-to-fit=no"
Html -> Html
H.title (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html
"IdrisDoc"
if Bool
index then Html
" Index" else do
Html
": "
FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml FilePath
str
Html
H.link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"text/css" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
rel AttributeValue
"stylesheet"
Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FilePath
styles)
Html -> Html
H.body (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (if Bool
index then AttributeValue
"index" else AttributeValue
"namespace") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"wrapper" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.header (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.strong Html
"IdrisDoc"
if Bool
index then Html
forall a. Monoid a => a
mempty else do
Html
": "
FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml FilePath
str
Html -> Html
H.nav (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (FilePath -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FilePath
indexPage) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Index"
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"container" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
inner
Html -> Html
H.footer (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html
"Produced by IdrisDoc version "
FilePath -> Html
forall a. ToMarkup a => a -> Html
toHtml FilePath
version
where extract :: Maybe NsName -> (Bool, FilePath)
extract (Just NsName
ns) = (Bool
False, NsName -> FilePath
nsName2Str NsName
ns)
extract Maybe NsName
_ = (Bool
True, FilePath
"")
nbsp :: H.Html
nbsp :: Html
nbsp = FilePath -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (FilePath
" " :: String)
existingNamespaces :: FilePath
-> IO (S.Set NsName)
existingNamespaces :: FilePath -> IO (Set NsName)
existingNamespaces FilePath
out = do
let docs :: FilePath
docs = FilePath
out FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"docs"
str2Ns :: FilePath -> NsName
str2Ns FilePath
s | FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
rootNsStr = []
str2Ns FilePath
s = NsName -> NsName
forall a. [a] -> [a]
reverse (NsName -> NsName) -> NsName -> NsName
forall a b. (a -> b) -> a -> b
$ Text -> Text -> NsName
T.splitOn (Char -> Text
T.singleton Char
'.') (FilePath -> Text
txt FilePath
s)
toNs :: FilePath -> IO (Maybe NsName)
toNs FilePath
fp = do Bool
isFile <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
docs FilePath -> FilePath -> FilePath
</> FilePath
fp
let isHtml :: Bool
isHtml = FilePath
".html" FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> FilePath
takeExtension FilePath
fp
name :: FilePath
name = FilePath -> FilePath
dropExtension FilePath
fp
ns :: NsName
ns = FilePath -> NsName
str2Ns FilePath
name
Maybe NsName -> IO (Maybe NsName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NsName -> IO (Maybe NsName))
-> Maybe NsName -> IO (Maybe NsName)
forall a b. (a -> b) -> a -> b
$ if Bool
isFile Bool -> Bool -> Bool
&& Bool
isHtml then NsName -> Maybe NsName
forall a. a -> Maybe a
Just NsName
ns else Maybe NsName
forall a. Maybe a
Nothing
Bool
docsExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
docs
if Bool -> Bool
not Bool
docsExists
then Set NsName -> IO (Set NsName)
forall (m :: * -> *) a. Monad m => a -> m a
return Set NsName
forall a. Set a
S.empty
else do [FilePath]
contents <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
docs
[NsName]
namespaces <- [Maybe NsName] -> [NsName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe NsName] -> [NsName]) -> IO [Maybe NsName] -> IO [NsName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([IO (Maybe NsName)] -> IO [Maybe NsName]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO (Maybe NsName)] -> IO [Maybe NsName])
-> [IO (Maybe NsName)] -> IO [Maybe NsName]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO (Maybe NsName))
-> [FilePath] -> [IO (Maybe NsName)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> IO (Maybe NsName)
toNs [FilePath]
contents)
Set NsName -> IO (Set NsName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set NsName -> IO (Set NsName)) -> Set NsName -> IO (Set NsName)
forall a b. (a -> b) -> a -> b
$ [NsName] -> Set NsName
forall a. Ord a => [a] -> Set a
S.fromList [NsName]
namespaces
copyDependencies :: FilePath
-> IO ()
copyDependencies :: FilePath -> IO ()
copyDependencies FilePath
dir =
do FilePath
styles <- FilePath -> IO FilePath
getIdrisDataFileByName (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"idrisdoc" FilePath -> FilePath -> FilePath
</> FilePath
"styles.css"
FilePath -> FilePath -> IO ()
copyFile FilePath
styles (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"styles.css")