shakebook-0.8.1.0: Shake-based technical documentation generator; HTML & PDF

Safe HaskellNone
LanguageHaskell2010

Shakebook.Conventions

Contents

Description

Conventions used for common shakebook projects, lenses, enrichments, affixes.

Synopsis

Lenses

viewImage :: ToJSON a => a -> Text Source #

View the "image" field of a JSON value.

viewModified :: ToJSON a => a -> UTCTime Source #

View the "modified" field of a JSON value.

viewPostTime :: ToJSON a => a -> UTCTime Source #

View the "date" field of a JSON Value as a UTCTime.

viewPostTimeRaw :: ToJSON a => a -> Text Source #

View the "date" field of a JSON Value as Text.

viewTags :: ToJSON a => a -> [Text] Source #

View the "tags" field of a JSON Value as a list.

viewTitle :: ToJSON a => a -> Text Source #

View the "title" field of a JSON Value.

viewAllPostTags :: ToJSON a => [a] -> [Text] Source #

View all post tags for a list of posts.

viewAllPostTimes :: ToJSON a => [a] -> [UTCTime] Source #

View all posts times for a list of posts.

withBaseUrl :: Text -> Value -> Value Source #

Add "base-url" field from input Text.

withFullUrl :: Text -> Value -> Value Source #

Add "full-url" field from input Text.

withHighlighting :: Style -> Value -> Value Source #

Add "highlighting-css" field from input Style.

withModified :: UTCTime -> Value -> Value Source #

Add "modified" field from input UTCTime.

withNext :: ToJSON a => a -> Value -> Value Source #

Add "next" field from input Value.

withPages :: ToJSON a => [a] -> Value -> Value Source #

Add "pages" field from input [Value].

withPrettyDate :: Text -> Value -> Value Source #

Add "prettydate" field using input Text.

withPrevious :: ToJSON a => a -> Value -> Value Source #

Add "previous" field using input Value.

withPosts :: ToJSON a => [a] -> Value -> Value Source #

Add "posts" field based on input [Value].

withRecentPosts :: ToJSON a => [a] -> Value -> Value Source #

Add "recent-posts" field using input Value.

withSocialLinks :: ToJSON a => [a] -> Value -> Value Source #

Add "social-links" field based on input [Value].

withSiteTitle :: Text -> Value -> Value Source #

Add "site-title" field from input Text.

withSubsections :: ToJSON a => [a] -> Value -> Value Source #

Add "subsections" field based on input [Value].

withTagIndex :: ToJSON a => [a] -> Value -> Value Source #

Add "tag-index" field based on input [Value].

withTagLinks :: ToJSON a => [a] -> Value -> Value Source #

Add "tag-links" field based on input [Value].

withTeaser :: Text -> Value -> Value Source #

Add "teaser" field based on input Text.

withTitle :: Text -> Value -> Value Source #

Add "title" field based on input Text.

Enrichments

enrichPrettyDate :: (UTCTime -> Text) -> Value -> Value Source #

Assuming a "date" field, enrich using withPrettyDate and a format string.

enrichTagLinks :: (Text -> Text) -> Value -> Value Source #

Assuming a "tags" field, enrich using withTagLinks.

enrichTeaser :: Text -> Value -> Value Source #

Assuming a "content" field with a spitter section, enrich using withTeaser

Extensions

extendNext :: Zipper [] Value -> Zipper [] Value Source #

Extend a Zipper of Values to add "next" objects.

extendPrevious :: Zipper [] Value -> Zipper [] Value Source #

Extend a Zipper of Values to add "previous" objects.

extendNextPrevious :: Zipper [] Value -> Zipper [] Value Source #

Add both "next" and "previous" fields using withPostNext and withPostPrevious

extendPageNeighbours :: Int -> Zipper [] Value -> Zipper [] Value Source #

Extend a Zipper of Values to add list of "pages" within r hops either side of the focus.

Generations

genBlogNavbarData Source #

Arguments

:: IsIndexOf YearMonth ixs 
=> Text

"Top level title, e.g Blog

-> Text

Root page, e.g "/posts"

-> (UTCTime -> Text)

Formatting function to a UTCTime to a title.

-> (UTCTime -> Text)

Formatting function to convert a UTCTime to a URL link

-> IxSet ixs Post 
-> Value 

Create a blog navbar object for a posts section, with layers "toc1", "toc2", and "toc3".

genIndexPageData :: (MonadThrow m, ToJSON a) => [a] -> Text -> (Text -> Text) -> Int -> m (Zipper [] Value) Source #

genLinkData :: Text -> Text -> Value Source #

Create link data object with fields "id" and "url" using an id and a function | transforming an id into a url.

genPageData :: ToJSON a => Text -> (Text -> Text) -> Zipper [] [a] -> Value Source #

genTocNavbarData :: Cofree [] Value -> Value Source #

Create a toc navbar object for a docs section, with layers "toc1", "toc2" and "toc3".

Indexing

newtype Post Source #

Indexable Post Type

Constructors

Post 

Fields

Instances
Eq Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

(==) :: Post -> Post -> Bool #

(/=) :: Post -> Post -> Bool #

Data Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Post -> c Post #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Post #

toConstr :: Post -> Constr #

dataTypeOf :: Post -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Post) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Post) #

gmapT :: (forall b. Data b => b -> b) -> Post -> Post #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Post -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Post -> r #

gmapQ :: (forall d. Data d => d -> u) -> Post -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Post -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Post -> m Post #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Post -> m Post #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Post -> m Post #

Ord Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

compare :: Post -> Post -> Ordering #

(<) :: Post -> Post -> Bool #

(<=) :: Post -> Post -> Bool #

(>) :: Post -> Post -> Bool #

(>=) :: Post -> Post -> Bool #

max :: Post -> Post -> Post #

min :: Post -> Post -> Post #

Show Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

showsPrec :: Int -> Post -> ShowS #

show :: Post -> String #

showList :: [Post] -> ShowS #

ToJSON Post Source # 
Instance details

Defined in Shakebook.Conventions

Indexable (Tag ': (Posted ': (YearMonth ': (SrcFile ': ([] :: [Type]))))) Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

indices :: IxList (Tag ': (Posted ': (YearMonth ': (SrcFile ': [])))) Post #

newtype Tag Source #

Tag indices for a Post for use with IxSet.

Constructors

Tag Text 
Instances
Eq Tag Source # 
Instance details

Defined in Shakebook.Conventions

Methods

(==) :: Tag -> Tag -> Bool #

(/=) :: Tag -> Tag -> Bool #

Data Tag Source # 
Instance details

Defined in Shakebook.Conventions

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Tag -> c Tag #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Tag #

toConstr :: Tag -> Constr #

dataTypeOf :: Tag -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Tag) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tag) #

gmapT :: (forall b. Data b => b -> b) -> Tag -> Tag #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tag -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tag -> r #

gmapQ :: (forall d. Data d => d -> u) -> Tag -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Tag -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Tag -> m Tag #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Tag -> m Tag #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Tag -> m Tag #

Ord Tag Source # 
Instance details

Defined in Shakebook.Conventions

Methods

compare :: Tag -> Tag -> Ordering #

(<) :: Tag -> Tag -> Bool #

(<=) :: Tag -> Tag -> Bool #

(>) :: Tag -> Tag -> Bool #

(>=) :: Tag -> Tag -> Bool #

max :: Tag -> Tag -> Tag #

min :: Tag -> Tag -> Tag #

Show Tag Source # 
Instance details

Defined in Shakebook.Conventions

Methods

showsPrec :: Int -> Tag -> ShowS #

show :: Tag -> String #

showList :: [Tag] -> ShowS #

Indexable (Tag ': (Posted ': (YearMonth ': (SrcFile ': ([] :: [Type]))))) Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

indices :: IxList (Tag ': (Posted ': (YearMonth ': (SrcFile ': [])))) Post #

newtype Posted Source #

Posted index for a Post for use with IxSet.

Constructors

Posted UTCTime 
Instances
Eq Posted Source # 
Instance details

Defined in Shakebook.Conventions

Methods

(==) :: Posted -> Posted -> Bool #

(/=) :: Posted -> Posted -> Bool #

Data Posted Source # 
Instance details

Defined in Shakebook.Conventions

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Posted -> c Posted #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Posted #

toConstr :: Posted -> Constr #

dataTypeOf :: Posted -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Posted) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Posted) #

gmapT :: (forall b. Data b => b -> b) -> Posted -> Posted #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Posted -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Posted -> r #

gmapQ :: (forall d. Data d => d -> u) -> Posted -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Posted -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Posted -> m Posted #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Posted -> m Posted #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Posted -> m Posted #

Ord Posted Source # 
Instance details

Defined in Shakebook.Conventions

Show Posted Source # 
Instance details

Defined in Shakebook.Conventions

Indexable (Tag ': (Posted ': (YearMonth ': (SrcFile ': ([] :: [Type]))))) Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

indices :: IxList (Tag ': (Posted ': (YearMonth ': (SrcFile ': [])))) Post #

newtype YearMonth Source #

YearMonth (yyyy, mm) index for a Post for use with IxSet.

Constructors

YearMonth (Integer, Int) 
Instances
Eq YearMonth Source # 
Instance details

Defined in Shakebook.Conventions

Data YearMonth Source # 
Instance details

Defined in Shakebook.Conventions

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> YearMonth -> c YearMonth #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c YearMonth #

toConstr :: YearMonth -> Constr #

dataTypeOf :: YearMonth -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c YearMonth) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c YearMonth) #

gmapT :: (forall b. Data b => b -> b) -> YearMonth -> YearMonth #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> YearMonth -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> YearMonth -> r #

gmapQ :: (forall d. Data d => d -> u) -> YearMonth -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> YearMonth -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> YearMonth -> m YearMonth #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> YearMonth -> m YearMonth #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> YearMonth -> m YearMonth #

Ord YearMonth Source # 
Instance details

Defined in Shakebook.Conventions

Show YearMonth Source # 
Instance details

Defined in Shakebook.Conventions

Indexable (Tag ': (Posted ': (YearMonth ': (SrcFile ': ([] :: [Type]))))) Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

indices :: IxList (Tag ': (Posted ': (YearMonth ': (SrcFile ': [])))) Post #

newtype SrcFile Source #

SrcFile index for a Post for use with IxSet.

Constructors

SrcFile Text 
Instances
Eq SrcFile Source # 
Instance details

Defined in Shakebook.Conventions

Methods

(==) :: SrcFile -> SrcFile -> Bool #

(/=) :: SrcFile -> SrcFile -> Bool #

Data SrcFile Source # 
Instance details

Defined in Shakebook.Conventions

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SrcFile -> c SrcFile #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SrcFile #

toConstr :: SrcFile -> Constr #

dataTypeOf :: SrcFile -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c SrcFile) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcFile) #

gmapT :: (forall b. Data b => b -> b) -> SrcFile -> SrcFile #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcFile -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcFile -> r #

gmapQ :: (forall d. Data d => d -> u) -> SrcFile -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SrcFile -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SrcFile -> m SrcFile #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SrcFile -> m SrcFile #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SrcFile -> m SrcFile #

Ord SrcFile Source # 
Instance details

Defined in Shakebook.Conventions

Show SrcFile Source # 
Instance details

Defined in Shakebook.Conventions

Indexable (Tag ': (Posted ': (YearMonth ': (SrcFile ': ([] :: [Type]))))) Post Source # 
Instance details

Defined in Shakebook.Conventions

Methods

indices :: IxList (Tag ': (Posted ': (YearMonth ': (SrcFile ': [])))) Post #

postIndex :: MonadAction m => (Within Rel (Path Rel File) -> m Value) -> Within Rel [FilePattern] -> m (IxSet '[Tag, Posted, YearMonth, SrcFile] Post) Source #

Take a Value loading function and a filepattern and return an indexable set of Posts.

postZipper :: (MonadThrow m, IsIndexOf Posted xs) => IxSet xs Post -> m (Zipper [] Post) Source #

Create a `Zipper [] Post` from an `IxSet xs Post` by ordering by Posted.