{-# LANGUAGE OverloadedStrings #-} module Rules.TopPage (rules) where import Control.Monad.Extra (mconcatMapM) import Control.Monad.Reader (ReaderT (..), asks) import Control.Monad.Trans (MonadTrans (..)) import Data.List.Extra (mconcatMap) import Data.Time.Format (formatTime) import Hakyll import System.FilePath (joinPath, (</>)) import Text.Pandoc.Walk (walkM) import Config (contentsRoot, defaultTimeLocale', readerOptions, siteName) import Config.Blog import Config.Contributions import Config.TopPage import Contexts (siteCtx) import qualified Contexts.Blog as CtxBlog import Media.SVG (mermaidTransform) import Rules.Blog.Type import Rules.PageType import Utils (mconcatM, modifyExternalLinkAttr) import qualified Vendor.FontAwesome as FA lastUpdate :: (MonadMetadata m, MonadFail m) => [Item a] -> m String lastUpdate :: forall (m :: * -> *) a. (MonadMetadata m, MonadFail m) => [Item a] -> m String lastUpdate [] = String -> m String forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure (String -> m String) -> String -> m String forall a b. (a -> b) -> a -> b $ TopPageConfig -> String noPostsAlt TopPageConfig topPageConfig lastUpdate (Item a x:[Item a] _) = TimeLocale -> String -> UTCTime -> String forall t. FormatTime t => TimeLocale -> String -> t -> String formatTime TimeLocale defaultTimeLocale' (TopPageConfig -> String postDateFormat TopPageConfig topPageConfig) (UTCTime -> String) -> m UTCTime -> m String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TimeLocale -> Identifier -> m UTCTime forall (m :: * -> *). (MonadMetadata m, MonadFail m) => TimeLocale -> Identifier -> m UTCTime getItemUTC TimeLocale defaultTimeLocale' (Item a -> Identifier forall a. Item a -> Identifier itemIdentifier Item a x) introDateCtx :: [Item a] -> BlogConfReader m Compiler (Context String) introDateCtx :: forall a (m :: * -> *). [Item a] -> BlogConfReader m Compiler (Context String) introDateCtx [Item a] posts = String -> String -> Context String forall a. String -> String -> Context a constField (String -> String -> Context String) -> ReaderT (BlogConfig m) Compiler String -> ReaderT (BlogConfig m) Compiler (String -> Context String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (BlogConfig m -> String) -> ReaderT (BlogConfig m) Compiler String forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((String -> String -> String forall a. Semigroup a => a -> a -> a <> String "-intro-date") (String -> String) -> (BlogConfig m -> String) -> BlogConfig m -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . BlogConfig m -> String forall (m :: * -> *). BlogConfig m -> String blogName) ReaderT (BlogConfig m) Compiler (String -> Context String) -> ReaderT (BlogConfig m) Compiler String -> ReaderT (BlogConfig m) Compiler (Context String) forall a b. ReaderT (BlogConfig m) Compiler (a -> b) -> ReaderT (BlogConfig m) Compiler a -> ReaderT (BlogConfig m) Compiler b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Compiler String -> ReaderT (BlogConfig m) Compiler String forall (m :: * -> *) a. Monad m => m a -> ReaderT (BlogConfig m) m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift ([Item a] -> Compiler String forall (m :: * -> *) a. (MonadMetadata m, MonadFail m) => [Item a] -> m String lastUpdate [Item a] posts) listPostsCtx :: [Item String] -> BlogConfReader m Compiler (Context String) listPostsCtx :: forall (m :: * -> *). [Item String] -> BlogConfReader m Compiler (Context String) listPostsCtx [Item String] posts = do String name <- (BlogConfig m -> String) -> ReaderT (BlogConfig m) Compiler String forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((String -> String -> String forall a. Semigroup a => a -> a -> a <> String "-posts") (String -> String) -> (BlogConfig m -> String) -> BlogConfig m -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . BlogConfig m -> String forall (m :: * -> *). BlogConfig m -> String blogName) Context String -> BlogConfReader m Compiler (Context String) forall a. a -> ReaderT (BlogConfig m) Compiler a forall (f :: * -> *) a. Applicative f => a -> f a pure (Context String -> BlogConfReader m Compiler (Context String)) -> Context String -> BlogConfReader m Compiler (Context String) forall a b. (a -> b) -> a -> b $ String -> Context String -> Compiler [Item String] -> Context String forall a b. String -> Context a -> Compiler [Item a] -> Context b listField String name (Context String siteCtx Context String -> Context String -> Context String forall a. Semigroup a => a -> a -> a <> Context String defaultContext) ([Item String] -> Compiler [Item String] forall a. a -> Compiler a forall (f :: * -> *) a. Applicative f => a -> f a pure [Item String] posts) mkBlogCtx :: BlogConfReader m Compiler (Context String) mkBlogCtx :: forall (m :: * -> *). BlogConfReader m Compiler (Context String) mkBlogCtx = do Pattern ep <- (BlogConfig m -> Pattern) -> ReaderT (BlogConfig m) Compiler Pattern forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks BlogConfig m -> Pattern forall (m :: * -> *). BlogConfig m -> Pattern blogEntryPattern String cs <- (BlogConfig m -> String) -> ReaderT (BlogConfig m) Compiler String forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks BlogConfig m -> String forall (m :: * -> *). BlogConfig m -> String blogContentSnapshot [Item String] posts <- Compiler [Item String] -> ReaderT (BlogConfig m) Compiler [Item String] forall (m :: * -> *) a. Monad m => m a -> ReaderT (BlogConfig m) m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Compiler [Item String] -> ReaderT (BlogConfig m) Compiler [Item String]) -> Compiler [Item String] -> ReaderT (BlogConfig m) Compiler [Item String] forall a b. (a -> b) -> a -> b $ ([Item String] -> [Item String]) -> Compiler [Item String] -> Compiler [Item String] forall a b. (a -> b) -> Compiler a -> Compiler b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Int -> [Item String] -> [Item String] forall a. Int -> [a] -> [a] take (Int -> [Item String] -> [Item String]) -> Int -> [Item String] -> [Item String] forall a b. (a -> b) -> a -> b $ TopPageConfig -> Int maxTitleNum TopPageConfig topPageConfig) (Compiler [Item String] -> Compiler [Item String]) -> ([Item String] -> Compiler [Item String]) -> [Item String] -> Compiler [Item String] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Item String] -> Compiler [Item String] forall (m :: * -> *) a. (MonadMetadata m, MonadFail m) => [Item a] -> m [Item a] recentFirst ([Item String] -> Compiler [Item String]) -> Compiler [Item String] -> Compiler [Item String] forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Pattern -> String -> Compiler [Item String] forall a. (Binary a, Typeable a) => Pattern -> String -> Compiler [Item a] loadAllSnapshots Pattern ep String cs [BlogConfReader m Compiler (Context String)] -> BlogConfReader m Compiler (Context String) forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b mconcatM [ [Item String] -> BlogConfReader m Compiler (Context String) forall (m :: * -> *). [Item String] -> BlogConfReader m Compiler (Context String) listPostsCtx [Item String] posts , BlogConfReader m Compiler (Context String) forall (m :: * -> *) (n :: * -> *). Monad m => BlogConfReader n m (Context String) CtxBlog.title , BlogConfReader m Compiler (Context String) forall (m :: * -> *) (n :: * -> *). Monad m => BlogConfReader n m (Context String) CtxBlog.description , [Item String] -> BlogConfReader m Compiler (Context String) forall a (m :: * -> *). [Item a] -> BlogConfReader m Compiler (Context String) introDateCtx [Item String] posts , Context String -> BlogConfReader m Compiler (Context String) forall a. a -> ReaderT (BlogConfig m) Compiler a forall (f :: * -> *) a. Applicative f => a -> f a pure Context String siteCtx , Context String -> BlogConfReader m Compiler (Context String) forall a. a -> ReaderT (BlogConfig m) Compiler a forall (f :: * -> *) a. Applicative f => a -> f a pure Context String defaultContext ] aboutSnapshot :: Snapshot aboutSnapshot :: String aboutSnapshot = String "aboutSS" rules :: [BlogConfig m] -> PageConfReader Rules () rules :: forall (m :: * -> *). [BlogConfig m] -> PageConfReader Rules () rules [BlogConfig m] bcs = do FontAwesomeIcons faIcons <- (PageConf -> FontAwesomeIcons) -> ReaderT PageConf Rules FontAwesomeIcons forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks PageConf -> FontAwesomeIcons pcFaIcons WriterOptions wOpt <- (PageConf -> WriterOptions) -> ReaderT PageConf Rules WriterOptions forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks PageConf -> WriterOptions pcWriterOpt Dependency projectsConfigDependency <- Rules Dependency -> ReaderT PageConf Rules Dependency forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Rules Dependency -> ReaderT PageConf Rules Dependency) -> Rules Dependency -> ReaderT PageConf Rules Dependency forall a b. (a -> b) -> a -> b $ Pattern -> Rules Dependency forall (m :: * -> *). MonadMetadata m => Pattern -> m Dependency makePatternDependency Pattern projectsDependencyPath Dependency contributionsConfigDependency <- Rules Dependency -> ReaderT PageConf Rules Dependency forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Rules Dependency -> ReaderT PageConf Rules Dependency) -> Rules Dependency -> ReaderT PageConf Rules Dependency forall a b. (a -> b) -> a -> b $ Pattern -> Rules Dependency forall (m :: * -> *). MonadMetadata m => Pattern -> m Dependency makePatternDependency Pattern contributionsDependencyPath Rules () -> PageConfReader Rules () forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Rules () -> PageConfReader Rules ()) -> Rules () -> PageConfReader Rules () forall a b. (a -> b) -> a -> b $ do Pattern -> Rules () -> Rules () match Pattern projectsConfigPattern (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ Compiler (Item String) -> Rules () forall a. (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules () compile Compiler (Item String) getResourceBody Pattern -> Rules () -> Rules () match Pattern contributionsConfigPattern (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ Compiler (Item String) -> Rules () forall a. (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules () compile Compiler (Item String) getResourceBody Pattern -> Rules () -> Rules () match Pattern contributionsTypeConfigPath (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ Compiler (Item String) -> Rules () forall a. (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules () compile Compiler (Item String) getResourceBody Pattern -> Rules () -> Rules () match Pattern aboutPattern (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ Compiler (Item String) -> Rules () forall a. (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules () compile (Compiler (Item String) -> Rules ()) -> Compiler (Item String) -> Rules () forall a b. (a -> b) -> a -> b $ ReaderOptions -> WriterOptions -> (Pandoc -> Compiler Pandoc) -> Compiler (Item String) pandocCompilerWithTransformM ReaderOptions readerOptions WriterOptions wOpt ((Block -> Compiler Block) -> Pandoc -> Compiler Pandoc forall a b (m :: * -> *). (Walkable a b, Monad m, Applicative m, Functor m) => (a -> m a) -> b -> m b forall (m :: * -> *). (Monad m, Applicative m, Functor m) => (Block -> m Block) -> Pandoc -> m Pandoc walkM Block -> Compiler Block mermaidTransform) Compiler (Item String) -> (Item String -> Compiler (Item String)) -> Compiler (Item String) forall a b. Compiler a -> (a -> Compiler b) -> Compiler b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= String -> Item String -> Compiler (Item String) forall a. (Binary a, Typeable a) => String -> Item a -> Compiler (Item a) saveSnapshot String aboutSnapshot [Dependency] -> Rules () -> Rules () forall a. [Dependency] -> Rules a -> Rules a rulesExtraDependencies [Dependency projectsConfigDependency] (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ [Identifier] -> Rules () -> Rules () create [Identifier projectsCachePath] (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ Compiler (Item String) -> Rules () forall a. (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules () compile (Compiler (Item String) -> Rules ()) -> Compiler (Item String) -> Rules () forall a b. (a -> b) -> a -> b $ String -> Compiler (Item String) forall a. a -> Compiler (Item a) makeItem (String -> Compiler (Item String)) -> Compiler String -> Compiler (Item String) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO String -> Compiler String forall a. IO a -> Compiler a unsafeCompiler IO String renderProjectsList [Dependency] -> Rules () -> Rules () forall a. [Dependency] -> Rules a -> Rules a rulesExtraDependencies [Dependency contributionsConfigDependency] (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ [Identifier] -> Rules () -> Rules () create [Identifier contributionsCachePath] (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ Compiler (Item String) -> Rules () forall a. (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules () compile (Compiler (Item String) -> Rules ()) -> Compiler (Item String) -> Rules () forall a b. (a -> b) -> a -> b $ String -> Compiler (Item String) forall a. a -> Compiler (Item a) makeItem (String -> Compiler (Item String)) -> Compiler String -> Compiler (Item String) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO String -> Compiler String forall a. IO a -> Compiler a unsafeCompiler IO String renderContributionsTable Pattern -> Rules () -> Rules () match Pattern indexPath (Rules () -> Rules ()) -> Rules () -> Rules () forall a b. (a -> b) -> a -> b $ do Routes -> Rules () route (Routes -> Rules ()) -> Routes -> Rules () forall a b. (a -> b) -> a -> b $ String -> (String -> String) -> Routes gsubRoute (String contentsRoot String -> String -> String </> String "pages/") (String -> String -> String forall a b. a -> b -> a const String forall a. Monoid a => a mempty) Compiler (Item String) -> Rules () forall a. (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules () compile (Compiler (Item String) -> Rules ()) -> Compiler (Item String) -> Rules () forall a b. (a -> b) -> a -> b $ do String projs <- Identifier -> Compiler String forall a. (Binary a, Typeable a) => Identifier -> Compiler a loadBody Identifier projectsCachePath String conts <- Identifier -> Compiler String forall a. (Binary a, Typeable a) => Identifier -> Compiler a loadBody Identifier contributionsCachePath let baseCtx :: Context a baseCtx = ((String, String) -> Context a) -> [(String, String)] -> Context a forall b a. Monoid b => (a -> b) -> [a] -> b mconcatMap ((String -> String -> Context a) -> (String, String) -> Context a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry String -> String -> Context a forall a. String -> String -> Context a constField) [ (String "title", String siteName) , (String "projs", String projs) , (String "contable", String conts) ] Context String topCtx <- [Compiler (Context String)] -> Compiler (Context String) forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b mconcatM [ Context String -> Compiler (Context String) forall a. a -> Compiler a forall (f :: * -> *) a. Applicative f => a -> f a pure Context String forall {a}. Context a baseCtx , (BlogConfig m -> Compiler (Context String)) -> [BlogConfig m] -> Compiler (Context String) forall (m :: * -> *) b a. (Monad m, Monoid b) => (a -> m b) -> [a] -> m b mconcatMapM (ReaderT (BlogConfig m) Compiler (Context String) -> BlogConfig m -> Compiler (Context String) forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT ReaderT (BlogConfig m) Compiler (Context String) forall (m :: * -> *). BlogConfReader m Compiler (Context String) mkBlogCtx) [BlogConfig m] bcs , String -> String -> Context String forall a. String -> String -> Context a constField String "sitemap-body" (String -> Context String) -> Compiler String -> Compiler (Context String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Identifier -> String -> Compiler String forall a. (Binary a, Typeable a) => Identifier -> String -> Compiler a loadSnapshotBody Identifier sitemapIdent String aboutSnapshot , String -> String -> Context String forall a. String -> String -> Context a constField String "updates-body" (String -> Context String) -> Compiler String -> Compiler (Context String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Identifier -> String -> Compiler String forall a. (Binary a, Typeable a) => Identifier -> String -> Compiler a loadSnapshotBody Identifier updatesIdent String aboutSnapshot ] Compiler (Item String) getResourceBody Compiler (Item String) -> (Item String -> Compiler (Item String)) -> Compiler (Item String) forall a b. Compiler a -> (a -> Compiler b) -> Compiler b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Context String -> Item String -> Compiler (Item String) applyAsTemplate Context String topCtx Compiler (Item String) -> (Item String -> Compiler (Item String)) -> Compiler (Item String) forall a b. Compiler a -> (a -> Compiler b) -> Compiler b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Identifier -> Context String -> Item String -> Compiler (Item String) forall a. Identifier -> Context a -> Item a -> Compiler (Item String) loadAndApplyTemplate Identifier rootTemplate Context String topCtx Compiler (Item String) -> (Item String -> Compiler (Item String)) -> Compiler (Item String) forall a b. Compiler a -> (a -> Compiler b) -> Compiler b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Item String -> Compiler (Item String) modifyExternalLinkAttr Compiler (Item String) -> (Item String -> Compiler (Item String)) -> Compiler (Item String) forall a b. Compiler a -> (a -> Compiler b) -> Compiler b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Item String -> Compiler (Item String) relativizeUrls Compiler (Item String) -> (Item String -> Compiler (Item String)) -> Compiler (Item String) forall a b. Compiler a -> (a -> Compiler b) -> Compiler b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= FontAwesomeIcons -> Item String -> Compiler (Item String) FA.render FontAwesomeIcons faIcons where aboutPattern :: Pattern aboutPattern = String -> Pattern fromGlob (String -> Pattern) -> String -> Pattern forall a b. (a -> b) -> a -> b $ [String] -> String joinPath [String contentsRoot, String "about", String "*.md"] projectsConfigPattern :: Pattern projectsConfigPattern = String -> Pattern fromGlob (String -> Pattern) -> String -> Pattern forall a b. (a -> b) -> a -> b $ [String] -> String joinPath [String contentsRoot, String "config", String "contributions", String "Projects.dhall"] contributionsConfigPattern :: Pattern contributionsConfigPattern = String -> Pattern fromGlob (String -> Pattern) -> String -> Pattern forall a b. (a -> b) -> a -> b $ [String] -> String joinPath [String contentsRoot, String "config", String "contributions", String "Contributions.dhall"] contributionsTypeConfigPath :: Pattern contributionsTypeConfigPath = String -> Pattern fromRegex String "^contents/config/contributions/Type/.+\\.dhall$" projectsDependencyPath :: Pattern projectsDependencyPath = Pattern projectsConfigPattern Pattern -> Pattern -> Pattern .||. Pattern contributionsTypeConfigPath contributionsDependencyPath :: Pattern contributionsDependencyPath = Pattern contributionsConfigPattern Pattern -> Pattern -> Pattern .||. Pattern contributionsTypeConfigPath projectsCachePath :: Identifier projectsCachePath = String -> Identifier fromFilePath String "top-page-projects-cache" contributionsCachePath :: Identifier contributionsCachePath = String -> Identifier fromFilePath String "top-page-contributions-cache" sitemapIdent :: Identifier sitemapIdent = String -> Identifier fromFilePath (String -> Identifier) -> String -> Identifier forall a b. (a -> b) -> a -> b $ [String] -> String joinPath [String contentsRoot, String "about", String "sitemap.md"] updatesIdent :: Identifier updatesIdent = String -> Identifier fromFilePath (String -> Identifier) -> String -> Identifier forall a b. (a -> b) -> a -> b $ [String] -> String joinPath [String contentsRoot, String "about", String "updates.md"] indexPath :: Pattern indexPath = String -> Pattern fromGlob (String -> Pattern) -> String -> Pattern forall a b. (a -> b) -> a -> b $ [String] -> String joinPath [String contentsRoot, String "pages", String "index.html"] rootTemplate :: Identifier rootTemplate = String -> Identifier fromFilePath (String -> Identifier) -> String -> Identifier forall a b. (a -> b) -> a -> b $ [String] -> String joinPath [String contentsRoot, String "templates", String "site", String "default.html"]