{-# 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] -> String -> IO (Either String ())
generateDocs IState
ist [Name]
nss' String
out =
do let nss :: [NsName]
nss = 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) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {a} {a}.
Num a =>
Map NsName a -> (a, IO ()) -> NsName -> (a, IO ())
checker NsDict
docs) (Int
0, forall (m :: * -> *) a. Monad m => a -> m a
return ()) [NsName]
nss
IO ()
io
if Int
c forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [NsName]
nss
then forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (IState -> NsDict -> String -> IO (Either String ())
createDocs IState
ist NsDict
docs String
out) (String -> IO (Either String ())
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
else String -> IO (Either String ())
err String
"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 | 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
cforall a. Num a => a -> a -> a
+a
1, do ()
prev <- IO ()
io; NsName -> IO ()
warnMissing NsName
ns)
warnMissing :: NsName -> IO ()
warnMissing NsName
ns =
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Warning: Ignoring empty or non-existing namespace '" forall a. [a] -> [a] -> [a]
++
(NsName -> String
nsName2Str NsName
ns) forall a. [a] -> [a] -> [a]
++ String
"'"
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 :: String -> IO (Either String ())
err String
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
s
version :: String
version :: String
version = String
"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) 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 :: String
rootNsStr = String
"[builtins]"
nsName2Str :: NsName
-> String
nsName2Str :: NsName -> String
nsName2Str NsName
n = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null NsName
n then String
rootNsStr else NsName -> String
name NsName
n
where name :: NsName -> String
name [] = []
name [Text
ns] = Text -> String
str Text
ns
name (Text
ns:NsName
nss) = (NsName -> String
name NsName
nss) forall a. [a] -> [a] -> [a]
++ (Char
'.' forall a. a -> [a] -> [a]
: Text -> String
str Text
ns)
fetchInfo :: IState
-> [NsName]
-> IO NsDict
fetchInfo :: IState -> [NsName] -> IO NsDict
fetchInfo IState
ist [NsName]
nss =
do let originNss :: Set NsName
originNss = forall a. Ord a => [a] -> Set a
S.fromList [NsName]
nss
NsDict
info <- IState -> IO NsDict
nsDict IState
ist
let accessible :: NsDict
accessible = 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 = 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 = forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null 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 forall a. Set a
S.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\NsName
k NsInfo
_ -> 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 (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 = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {d}. Maybe (Docs' d) -> [Name]
names forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Name
_, Maybe (Docs' FullDocstring)
d, Accessibility
_) -> Maybe (Docs' FullDocstring)
d)) [NsItem]
list
in forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Bool
S.notMember Set Name
children) 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)) = 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)) = 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 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(FD Name
n d
_ [(Name, PTerm, Plicity, Maybe d)]
_ PTerm
_ Maybe Fixity
_) -> Name
n) (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 <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup NsName
ns NsDict
nsd = forall a b. (a -> b) -> [a] -> [b]
map NsItem -> Set NsName
referredNss (NsInfo -> [NsItem]
nsContents NsInfo
nsis)
nsTracer NsName
_ = [forall a. Set a
S.empty]
reached :: Set NsName
reached = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NsName -> [Set NsName]
nsTracer (forall a. Set a -> [a]
S.toList Set NsName
sT)
processed :: Set NsName
processed = forall a. Ord a => Set a -> Set a -> Set a
S.union Set NsName
sT Set NsName
sD
untraced :: Set NsName
untraced = forall a. Ord a => Set a -> Set a -> Set a
S.difference Set NsName
reached Set NsName
processed
in if 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
_) = forall a. Set a
S.empty
referredNss (Name
n, Just Docs' FullDocstring
d, Accessibility
_) =
let fds :: [FunDoc' FullDocstring]
fds = forall {d}. Docs' d -> [FunDoc' d]
getFunDocs Docs' FullDocstring
d
ts :: [PTerm]
ts = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {d}. FunDoc' d -> [PTerm]
types [FunDoc' FullDocstring]
fds
names :: [Name]
names = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PTerm -> [Name]
extractPTermNames) [PTerm]
ts
in forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Name -> NsName
getNs forall a b. (a -> b) -> a -> b
$ 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
fforall 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
fforall a. a -> [a] -> [a]
:[FunDoc' d]
fs
getFunDocs (NamedImplementationDoc Name
_ FunDoc' d
fd) = [FunDoc' d
fd]
getFunDocs (ModDoc [String]
_ d
_) = []
types :: FunDoc' d -> [PTerm]
types (FD Name
_ d
_ [(Name, PTerm, Plicity, Maybe d)]
args PTerm
t Maybe Fixity
_) = PTerm
tforall a. a -> [a] -> [a]
:(forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl IO NsDict -> (Name, NsInfo) -> IO NsDict
addModDoc) [(Name, NsInfo)]
modDocs forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {b}. IO NsDict -> (Name, b) -> IO NsDict
adder (forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
M.empty) [(Name, Def)]
nameDefList
where nameDefList :: [(Name, Def)]
nameDefList = Context -> [(Name, Def)]
ctxtAlist 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 forall a. Maybe a
Nothing [(Name
n, Maybe (Docs' FullDocstring)
doc, Accessibility
access)]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FullDocstring
m') ([NsItem]
ns forall a. [a] -> [a] -> [a]
++ [NsItem]
ns')
modDocs :: [(Name, NsInfo)]
modDocs = forall a b. (a -> b) -> [a] -> [b]
map (\(Name
mn, FullDocstring
d) -> (Name
mn, Maybe FullDocstring -> [NsItem] -> NsInfo
NsInfo (forall a. a -> Maybe a
Just FullDocstring
d) [])) forall a b. (a -> b) -> a -> b
$ 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Name -> HowMuchDocs -> Idris (Docs' FullDocstring)
getDocs Name
n HowMuchDocs
FullDocs) IState
ist
case Either Err (Docs' FullDocstring)
docs of Right Docs' FullDocstring
d -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Docs' FullDocstring
d)
Left Err
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. a -> [a] -> [a]
: 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 forall a. a -> [a] -> [a]
: 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 forall a. a -> [a] -> [a]
: 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) = 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PArg -> [Name]
extractPArg [PArg]
pas
in (PTerm -> [Name]
extract PTerm
p) forall a. [a] -> [a] -> [a]
++ [Name]
names
extractPTermNames (PAppBind FC
_ PTerm
p [PArg]
pas) = let names :: [Name]
names = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PArg -> [Name]
extractPArg [PArg]
pas
in (PTerm -> [Name]
extract PTerm
p) 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) = forall a b. [(a, b)] -> ([a], [b])
unzip [(PTerm, PTerm)]
ps
in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract (PTerm
pforall a. a -> [a] -> [a]
:([PTerm]
ps1 forall a. [a] -> [a] -> [a]
++ [PTerm]
ps2))
extractPTermNames (PIfThenElse FC
_ PTerm
c PTerm
t PTerm
f) = 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 =
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
_) = 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) = 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) = 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) = 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 forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract [PTerm
p1, PTerm
p2]
extractPTermNames (PDoBlock [PDo]
pdos) = 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) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTactic -> [Name]
extractPTactic [PTactic]
tacts
extractPTermNames (PTactics [PTactic]
tacts) = 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 [String]
_) = 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 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 forall a. a -> [a] -> [a]
: (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 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) = forall a b. [(a, b)] -> ([a], [b])
unzip [(PTerm, PTerm)]
ps
ps' :: [PTerm]
ps' = [PTerm]
ps1 forall a. [a] -> [a] -> [a]
++ [PTerm]
ps2
in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract (PTerm
p1 forall a. a -> [a] -> [a]
: PTerm
p2 forall a. a -> [a] -> [a]
: [PTerm]
ps')
extractPDo (DoLet FC
_ RigCount
_ Name
n FC
_ PTerm
p1 PTerm
p2) = Name
n forall a. a -> [a] -> [a]
: 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) = forall a b. [(a, b)] -> ([a], [b])
unzip [(PTerm, PTerm)]
ps
ps' :: [PTerm]
ps' = [PTerm]
ps1 forall a. [a] -> [a] -> [a]
++ [PTerm]
ps2
in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PTerm -> [Name]
extract (PTerm
p1 forall a. a -> [a] -> [a]
: PTerm
p2 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 forall a. a -> [a] -> [a]
: PTerm -> [Name]
extract PTerm
p
extractPTactic (LetTacTy Name
n PTerm
p1 PTerm
p2) = Name
n forall a. a -> [a] -> [a]
: 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 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) = 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) = 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 String
_ 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 -> String -> IO (Either String ())
createDocs IState
ist NsDict
nsd String
out =
do Bool
new <- Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ String
out String -> String -> String
</> String
"IdrisDoc")
Set NsName
existing_nss <- String -> IO (Set NsName)
existingNamespaces String
out
let nss :: Set NsName
nss = forall a. Ord a => Set a -> Set a -> Set a
S.union (forall k a. Map k a -> Set k
M.keysSet NsDict
nsd) Set NsName
existing_nss
Bool
dExists <- String -> IO Bool
doesDirectoryExist String
out
if Bool
new Bool -> Bool -> Bool
&& Bool
dExists then String -> IO (Either String ())
err forall a b. (a -> b) -> a -> b
$ String
"Output directory (" forall a. [a] -> [a] -> [a]
++ String
out forall a. [a] -> [a] -> [a]
++ String
") is" forall a. [a] -> [a] -> [a]
++
String
" already in use for other than IdrisDoc."
else do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
out
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. IO a -> (NsName, NsInfo) -> IO ()
docGen (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall k a. Map k a -> [(k, a)]
M.toList NsDict
nsd)
Set NsName -> String -> IO ()
createIndex Set NsName
nss String
out
if Bool
new
then forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile (String
out String -> String -> String
</> String
"IdrisDoc") IOMode
WriteMode ((forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> String -> IO ()
hPutStr) String
"")
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
String -> IO ()
copyDependencies String
out
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> String -> IO ()
createNsDoc IState
ist NsName
n NsInfo
c String
out
createIndex :: S.Set NsName
-> FilePath
-> IO ()
createIndex :: Set NsName -> String -> IO ()
createIndex Set NsName
nss String
out =
do (String
path, Handle
h) <- String -> String -> IO (String, Handle)
openTempFileWithDefaultPermissions String
out String
"index.html"
Handle -> ByteString -> IO ()
BS2.hPut Handle
h forall a b. (a -> b) -> a -> b
$ Html -> ByteString
renderHtml forall a b. (a -> b) -> a -> b
$ Maybe NsName -> Html -> Html
wrapper forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.h1 Html
"Namespaces"
Html -> Html
H.ul forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"names" forall a b. (a -> b) -> a -> b
$ do
let path :: NsName -> String
path NsName
ns = String
"docs" forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ NsName -> String -> String
genRelNsPath NsName
ns String
"html"
item :: NsName -> Html
item NsName
ns = do let n :: Html
n = forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ NsName -> String
nsName2Str NsName
ns
link :: AttributeValue
link = forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ NsName -> String
path NsName
ns
Html -> Html
H.li forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
link forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"code" forall a b. (a -> b) -> a -> b
$ Html
n
sort :: [NsName] -> [NsName]
sort = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\NsName
n1 NsName
n2 -> forall a. [a] -> [a]
reverse NsName
n1 forall a. Ord a => a -> a -> Ordering
`compare` forall a. [a] -> [a]
reverse NsName
n2)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([NsName] -> [NsName]
sort forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set NsName
nss) NsName -> Html
item
Handle -> IO ()
hClose Handle
h
String -> String -> IO ()
renameFile String
path (String
out String -> String -> String
</> String
"index.html")
createNsDoc :: IState
-> NsName
-> NsInfo
-> FilePath
-> IO ()
createNsDoc :: IState -> NsName -> NsInfo -> String -> IO ()
createNsDoc IState
ist NsName
ns NsInfo
content String
out =
do let tpath :: String
tpath = String
out String -> String -> String
</> String
"docs" String -> String -> String
</> (NsName -> String -> String
genRelNsPath NsName
ns String
"html")
dir :: String
dir = String -> String
takeDirectory String
tpath
file :: String
file = String -> String
takeFileName String
tpath
haveDocs :: (a, b, c) -> b
haveDocs (a
_, b
md, c
_) = b
md
content' :: [Docs' FullDocstring]
content' = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {b} {c}. (a, b, c) -> b
haveDocs forall a b. (a -> b) -> a -> b
$ NsInfo -> [NsItem]
nsContents NsInfo
content
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
(String
path, Handle
h) <- String -> String -> IO (String, Handle)
openTempFileWithDefaultPermissions String
dir String
file
Handle -> ByteString -> IO ()
BS2.hPut Handle
h forall a b. (a -> b) -> a -> b
$ Html -> ByteString
renderHtml forall a b. (a -> b) -> a -> b
$ Maybe NsName -> Html -> Html
wrapper (forall a. a -> Maybe a
Just NsName
ns) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.h1 forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml (NsName -> String
nsName2Str NsName
ns)
case NsInfo -> Maybe FullDocstring
nsDocstring NsInfo
content of
Maybe FullDocstring
Nothing -> forall a. Monoid a => a
mempty
Just FullDocstring
docstring -> FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring
Html -> Html
H.dl forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" forall a b. (a -> b) -> a -> b
$ 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
String -> String -> IO ()
renameFile String
path String
tpath
genRelNsPath :: NsName
-> String
-> FilePath
genRelNsPath :: NsName -> String -> String
genRelNsPath NsName
ns String
suffix = NsName -> String
nsName2Str NsName
ns String -> String -> String
<.> String
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 forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ String
"name " forall a. [a] -> [a] -> [a]
++ Name -> String
getType Name
n)
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
n)
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Name -> String
name forall a b. (a -> b) -> a -> b
$ Name -> Name
nsroot Name
n
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" forall a b. (a -> b) -> a -> b
$ do Html
nbsp; Html
":"; Html
nbsp
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"signature" forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml String
htmlSignature
where
htmlSignature :: String
htmlSignature = forall a. (a -> String -> String) -> SimpleDoc a -> String
displayDecorated OutputAnnotation -> String -> String
decorator forall a b. (a -> b) -> a -> b
$ 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 (String -> Text
txt String
"__") Text
n') ]
decorator :: OutputAnnotation -> String -> String
decorator (AnnConst Const
c) String
str | Const -> Bool
constIsType Const
c = String -> String -> String -> String
htmlSpan String
str String
"type" String
str
| Bool
otherwise = String -> String -> String -> String
htmlSpan String
str String
"data" String
str
decorator (AnnData String
_ String
_) String
str = String -> String -> String -> String
htmlSpan String
str String
"data" String
str
decorator (AnnType String
_ String
_) String
str = String -> String -> String -> String
htmlSpan String
str String
"type" String
str
decorator OutputAnnotation
AnnKeyword String
str = String -> String -> String -> String
htmlSpan String
"" String
"keyword" String
str
decorator (AnnBoundName Name
n Bool
i) String
str | Just String
t <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n Map Name String
docs =
let cs :: String
cs = (if Bool
i then String
"implicit " else String
"") forall a. [a] -> [a] -> [a]
++ String
"documented boundvar"
in String -> String -> String -> String
htmlSpan String
t String
cs String
str
decorator (AnnBoundName Name
_ Bool
i) String
str =
let cs :: String
cs = (if Bool
i then String
"implicit " else String
"") forall a. [a] -> [a] -> [a]
++ String
"boundvar"
in String -> String -> String -> String
htmlSpan String
"" String
cs String
str
decorator (AnnName Name
n Maybe NameOutput
_ Maybe String
_ Maybe String
_) String
str
| Name -> Bool
filterName Name
n = String -> String -> String -> String -> String
htmlLink (forall a. Show a => a -> String
show Name
n) (Name -> String
getType Name
n) (Name -> String
link Name
n) String
str
| Bool
otherwise = String -> String -> String -> String
htmlSpan String
"" (Name -> String
getType Name
n) String
str
decorator (AnnTextFmt TextFormatting
BoldText) String
str = String
"<b>" forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
"</b>"
decorator (AnnTextFmt TextFormatting
UnderlineText) String
str = String
"<u>" forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
"</u>"
decorator (AnnTextFmt TextFormatting
ItalicText) String
str = String
"<i>" forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
"</i>"
decorator OutputAnnotation
_ String
str = String
str
htmlSpan :: String -> String -> String -> String
htmlSpan :: String -> String -> String -> String
htmlSpan String
t String
cs String
str = do
Html -> String
R.renderHtml forall a b. (a -> b) -> a -> b
$ Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (forall a. ToValue a => a -> AttributeValue
toValue String
cs)
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (forall a. ToValue a => a -> AttributeValue
toValue String
t)
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml String
str
htmlLink :: String -> String -> String -> String -> String
htmlLink :: String -> String -> String -> String -> String
htmlLink String
t String
cs String
a String
str = do
Html -> String
R.renderHtml forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (forall a. ToValue a => a -> AttributeValue
toValue String
cs)
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (forall a. ToValue a => a -> AttributeValue
toValue String
t) forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (forall a. ToValue a => a -> AttributeValue
toValue String
a)
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml String
str
docs :: Map Name String
docs = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {b} {c}.
(a, b, c, Maybe FullDocstring) -> Maybe (a, String)
docExtractor [(Name, PTerm, Plicity, Maybe FullDocstring)]
args
docExtractor :: (a, b, c, Maybe FullDocstring) -> Maybe (a, String)
docExtractor (a
_, b
_, c
_, Maybe FullDocstring
Nothing) = forall a. Maybe a
Nothing
docExtractor (a
n, b
_, c
_, Just FullDocstring
d) = forall a. a -> Maybe a
Just (a
n, FullDocstring -> String
doc2Str FullDocstring
d)
doc2Str :: FullDocstring -> String
doc2Str FullDocstring
d = let dirty :: String
dirty = Html -> String
renderMarkup forall a b. (a -> b) -> a -> b
$ forall a. MarkupM a -> MarkupM a
contents forall a b. (a -> b) -> a -> b
$ FullDocstring -> Html
Docstrings.renderHtml FullDocstring
d
in forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dirty forall a. Num a => a -> a -> a
- Int
8) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
3 String
dirty
name :: Name -> String
name (NS Name
n NsName
ns) = forall a. Show a => a -> String
show (Name -> NsName -> Name
NS (String -> Name
sUN forall a b. (a -> b) -> a -> b
$ Name -> String
name Name
n) NsName
ns)
name Name
n = let n' :: String
n' = forall a. Show a => a -> String
show Name
n
in if (forall a. [a] -> a
head String
n') forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
opChars
then Char
'('forall a. a -> [a] -> [a]
:(String
n' forall a. [a] -> [a] -> [a]
++ String
")")
else String
n'
link :: Name -> String
link Name
n = let path :: String
path = NsName -> String -> String
genRelNsPath (Name -> NsName
getNs Name
n) String
"html"
in String
path forall a. [a] -> [a] -> [a]
++ String
"#" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show Name
n)
getType :: Name -> String
getType :: Name -> String
getType Name
n = let ctxt :: Context
ctxt = IState -> Context
tt_ctxt IState
ist
in case () of
()
_ | Name -> Context -> Bool
isDConName Name
n Context
ctxt -> String
"constructor"
()
_ | Name -> Context -> Bool
isFnName Name
n Context
ctxt -> String
"function"
()
_ | Name -> Context -> Bool
isTConName Name
n Context
ctxt -> String
"type"
()
_ | Bool
otherwise -> String
""
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 forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
name) forall a b. (a -> b) -> a -> b
$ IState -> FunDoc' FullDocstring -> Html
genTypeHeader IState
ist FunDoc' FullDocstring
fd
Html -> Html
H.dd forall a b. (a -> b) -> a -> b
$ do
(if forall a. Docstring a -> Bool
nullDocstring FullDocstring
docstring then forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring)
let args' :: [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
_, PTerm
_, Plicity
_, Maybe FullDocstring
d) -> forall a. Maybe a -> Bool
isJust Maybe FullDocstring
d) [(Name, PTerm, Plicity, Maybe FullDocstring)]
args
if (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, PTerm, Plicity, Maybe FullDocstring)]
args') Bool -> Bool -> Bool
|| (forall a. Maybe a -> Bool
isJust Maybe Fixity
fixity)
then Html -> Html
H.dl forall a b. (a -> b) -> a -> b
$ do
if (forall a. Maybe a -> Bool
isJust Maybe Fixity
fixity) then do
Html -> Html
H.dt forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"fixity" forall a b. (a -> b) -> a -> b
$ Html
"Fixity"
let f :: Fixity
f = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Fixity
fixity
Html -> Html
H.dd forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"fixity" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Fixity
f) forall a b. (a -> b) -> a -> b
$ Fixity -> Html
genFix Fixity
f
else forall a. Monoid a => a
mempty
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' forall {a} {b} {c}.
Show a =>
(a, b, c, Maybe FullDocstring) -> Html
genArg
else forall a. Monoid a => a
mempty
where genFix :: Fixity -> Html
genFix (Infixl {prec :: Fixity -> Int
prec=Int
p}) =
forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ String
"Left associative, precedence " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
p
genFix (Infixr {prec :: Fixity -> Int
prec=Int
p}) =
forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ String
"Left associative, precedence " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
p
genFix (InfixN {prec :: Fixity -> Int
prec=Int
p}) =
forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ String
"Non-associative, precedence " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
p
genFix (PrefixN {prec :: Fixity -> Int
prec=Int
p}) =
forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ String
"Prefix, precedence " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
p
genArg :: (a, b, c, Maybe FullDocstring) -> Html
genArg (a
_, b
_, c
_, Maybe FullDocstring
Nothing) = forall a. Monoid a => a
mempty
genArg (a
name, b
_, c
_, Just FullDocstring
docstring) = do
Html -> Html
H.dt forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
name
Html -> Html
H.dd 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 forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
n) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" forall a b. (a -> b) -> a -> b
$ do Html
"interface"; Html
nbsp
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"name type"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
n)
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Name -> String
name forall a b. (a -> b) -> a -> b
$ Name -> Name
nsroot Name
n
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"signature" forall a b. (a -> b) -> a -> b
$ Html
nbsp
Html -> Html
H.dd forall a b. (a -> b) -> a -> b
$ do
(if forall a. Docstring a -> Bool
nullDocstring FullDocstring
docstring then forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring)
Html -> Html
H.dl forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Maybe a -> [a]
maybeToList Maybe (FunDoc' FullDocstring)
c forall a. [a] -> [a] -> [a]
++ [FunDoc' FullDocstring]
fds) (IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist))
where name :: Name -> String
name (NS Name
n NsName
ns) = forall a. Show a => a -> String
show (Name -> NsName -> Name
NS (String -> Name
sUN forall a b. (a -> b) -> a -> b
$ Name -> String
name Name
n) NsName
ns)
name Name
n = let n' :: String
n' = forall a. Show a => a -> String
show Name
n
in if (forall a. [a] -> a
head String
n') forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
opChars
then Char
'('forall a. a -> [a] -> [a]
:(String
n' forall a. [a] -> [a] -> [a]
++ String
")")
else String
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 forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
n) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" forall a b. (a -> b) -> a -> b
$ do Html
"record"; Html
nbsp
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"name type"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
title (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
n)
forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Name -> String
name forall a b. (a -> b) -> a -> b
$ Name -> Name
nsroot Name
n
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"type" forall a b. (a -> b) -> a -> b
$ do Html
nbsp ; Html
prettyParameters
Html -> Html
H.dd forall a b. (a -> b) -> a -> b
$ do
(if forall a. Docstring a -> Bool
nullDocstring FullDocstring
doc then forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
doc)
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, PTerm, Maybe FullDocstring)]
params
then Html -> Html
H.dl forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, PTerm, Maybe FullDocstring)]
params forall {b}. (Name, b, Maybe FullDocstring) -> Html
genParam
else forall a. Monoid a => a
mempty
Html -> Html
H.dl forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" forall a b. (a -> b) -> a -> b
$ IState -> FunDoc' FullDocstring -> Html
createFunDoc IState
ist FunDoc' FullDocstring
ctor
Html -> Html
H.dl forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" forall a b. (a -> b) -> a -> b
$ 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 -> String
name (NS Name
n NsName
ns) = forall a. Show a => a -> String
show (Name -> NsName -> Name
NS (String -> Name
sUN forall a b. (a -> b) -> a -> b
$ Name -> String
name Name
n) NsName
ns)
name Name
n = let n' :: String
n' = forall a. Show a => a -> String
show Name
n
in if (forall a. [a] -> a
head String
n') forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
opChars
then Char
'('forall a. a -> [a] -> [a]
:(String
n' forall a. [a] -> [a] -> [a]
++ String
")")
else String
n'
genParam :: (Name, b, Maybe FullDocstring) -> Html
genParam (Name
name, b
pt, Maybe FullDocstring
docstring) = do
Html -> Html
H.dt forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Name -> Name
nsroot Name
name)
Html -> Html
H.dd forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
nbsp FullDocstring -> Html
Docstrings.renderHtml Maybe FullDocstring
docstring
prettyParameters :: Html
prettyParameters = forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [forall a. Show a => a -> String
show 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 forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.id forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
n) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"word" 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 forall a b. (a -> b) -> a -> b
$ do
(if forall a. Docstring a -> Bool
nullDocstring FullDocstring
docstring then forall a. Monoid a => a
mempty else FullDocstring -> Html
Docstrings.renderHtml FullDocstring
docstring)
let args' :: [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
_, PTerm
_, Plicity
_, Maybe FullDocstring
d) -> forall a. Maybe a -> Bool
isJust Maybe FullDocstring
d) [(Name, PTerm, Plicity, Maybe FullDocstring)]
args
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, PTerm, Plicity, Maybe FullDocstring)]
args'
then Html -> Html
H.dl forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, PTerm, Plicity, Maybe FullDocstring)]
args' forall {a} {b} {c}.
Show a =>
(a, b, c, Maybe FullDocstring) -> Html
genArg
else forall a. Monoid a => a
mempty
Html -> Html
H.dl forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"decls" forall a b. (a -> b) -> a -> b
$ 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) = forall a. Monoid a => a
mempty
genArg (a
name, b
_, c
_, Just FullDocstring
docstring) = do
Html -> Html
H.dt forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
name
Html -> Html
H.dd 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 [String]
_ 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, String
str) = Maybe NsName -> (Bool, String)
extract Maybe NsName
ns
base :: String
base = if Bool
index then String
"" else String
"../"
styles :: String
styles = String
base forall a. [a] -> [a] -> [a]
++ String
"styles.css" :: String
indexPage :: String
indexPage = String
base forall a. [a] -> [a] -> [a]
++ String
"index.html" :: String
in Html -> Html
H.docTypeHtml forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.head forall a b. (a -> b) -> a -> b
$ do
Html
H.meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"utf-8"
Html
H.meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"viewport" 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 forall a b. (a -> b) -> a -> b
$ do
Html
"IdrisDoc"
if Bool
index then Html
" Index" else do
Html
": "
forall a. ToMarkup a => a -> Html
toHtml String
str
Html
H.link forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"text/css" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
rel AttributeValue
"stylesheet"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (forall a. ToValue a => a -> AttributeValue
toValue String
styles)
Html -> Html
H.body forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (if Bool
index then AttributeValue
"index" else AttributeValue
"namespace") forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"wrapper" forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.header forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.strong Html
"IdrisDoc"
if Bool
index then forall a. Monoid a => a
mempty else do
Html
": "
forall a. ToMarkup a => a -> Html
toHtml String
str
Html -> Html
H.nav forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (forall a. ToValue a => a -> AttributeValue
toValue String
indexPage) forall a b. (a -> b) -> a -> b
$ Html
"Index"
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"container" forall a b. (a -> b) -> a -> b
$ Html
inner
Html -> Html
H.footer forall a b. (a -> b) -> a -> b
$ do
Html
"Produced by IdrisDoc version "
forall a. ToMarkup a => a -> Html
toHtml String
version
where extract :: Maybe NsName -> (Bool, String)
extract (Just NsName
ns) = (Bool
False, NsName -> String
nsName2Str NsName
ns)
extract Maybe NsName
_ = (Bool
True, String
"")
nbsp :: H.Html
nbsp :: Html
nbsp = forall a. ToMarkup a => a -> Html
preEscapedToHtml (String
" " :: String)
existingNamespaces :: FilePath
-> IO (S.Set NsName)
existingNamespaces :: String -> IO (Set NsName)
existingNamespaces String
out = do
let docs :: String
docs = String
out forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
"docs"
str2Ns :: String -> NsName
str2Ns String
s | String
s forall a. Eq a => a -> a -> Bool
== String
rootNsStr = []
str2Ns String
s = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Text -> Text -> NsName
T.splitOn (Char -> Text
T.singleton Char
'.') (String -> Text
txt String
s)
toNs :: String -> IO (Maybe NsName)
toNs String
fp = do Bool
isFile <- String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ String
docs String -> String -> String
</> String
fp
let isHtml :: Bool
isHtml = String
".html" forall a. Eq a => a -> a -> Bool
== String -> String
takeExtension String
fp
name :: String
name = String -> String
dropExtension String
fp
ns :: NsName
ns = String -> NsName
str2Ns String
name
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
isFile Bool -> Bool -> Bool
&& Bool
isHtml then forall a. a -> Maybe a
Just NsName
ns else forall a. Maybe a
Nothing
Bool
docsExists <- String -> IO Bool
doesDirectoryExist String
docs
if Bool -> Bool
not Bool
docsExists
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Set a
S.empty
else do [String]
contents <- String -> IO [String]
getDirectoryContents String
docs
[NsName]
namespaces <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> IO (Maybe NsName)
toNs [String]
contents)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [NsName]
namespaces
copyDependencies :: FilePath
-> IO ()
copyDependencies :: String -> IO ()
copyDependencies String
dir =
do String
styles <- String -> IO String
getIdrisDataFileByName forall a b. (a -> b) -> a -> b
$ String
"idrisdoc" String -> String -> String
</> String
"styles.css"
String -> String -> IO ()
copyFile String
styles (String
dir String -> String -> String
</> String
"styles.css")