shakebook-0.11.0.0: test/Spec.hs

{-# LANGUAGE TemplateHaskell #-}

import           Composite.Record
import qualified Data.IxSet.Typed                as Ix
import qualified Data.IxSet.Typed.Conversions    as Ix
import           Data.List.Split
import           Data.Text.Time
import           Development.Shake.Plus.Extended
import           Lucid
import           Lucid.Base
import           Path.Extensions
import           RIO
import           RIO.List
import           RIO.List.Partial
import           RIO.Partial
import qualified RIO.Text                        as T
import qualified RIO.Text.Lazy                   as LT
import           Shakebook                       hiding ((:->))
import           Shakebook.Utils
import           Test.Tasty
import           Test.Tasty.Golden

sourceFolder :: Path Rel Dir
sourceFolder = $(mkRelDir "test/site")

outputFolder :: Path Rel Dir
outputFolder = $(mkRelDir "test/public")

baseUrl :: Text
baseUrl = "http://blanky.test"

siteTitle :: Text
siteTitle = "Blanky Site"

tableOfContents :: Cofree [] (Path Rel File)
tableOfContents = $(mkRelFile "docs/index.html") :< [
                    $(mkRelFile "docs/1/index.html") :< []
                  , $(mkRelFile "docs/2/index.html") :< [
                  $(mkRelFile "docs/2/champ.html") :< []
                    ]
                  ]

numRecentPosts :: Int
numRecentPosts = 3

postsPerPage :: Int
postsPerPage = 5

mySocial :: [Record Link]
mySocial = ["twitter" :*: "http://twitter.com/blanky-site-nowhere" :*: RNil
           ,"youtube" :*: "http://youtube.com/blanky-site-nowhere" :*: RNil
           ,"gitlab"  :*: "http://gitlab.com/blanky-site-nowhere" :*: RNil]

addUrl :: (MonadThrow m, RElem FSrcPath xs) => Record xs -> m (Record (FUrl : xs))
addUrl = addDerivedUrl (fmap toGroundedUrl . withHtmlExtension <=< stripProperPrefix sourceFolder)

stage1Post :: (MonadAction m, MonadThrow m) => Record RawPost -> m (Record Stage1Post)
stage1Post = addUrl >=> return . addTeaser >=> addTagLinks >=> return . addPrettyDate

stage1Doc :: MonadThrow m => Record RawDoc -> m (Record Stage1Doc)
stage1Doc = addUrl

enrichPage :: Record x -> Record (Enriched x)
enrichPage x = mySocial :*: (LT.toStrict . renderText $ defaultCdnImports) :*: defaultHighlighting :*: siteTitle :*: x

rules :: ShakePlus SimpleSPlusEnv ()
rules = do

  readMD <- newCache $ \x -> do
    logInfo $ "Loading " <> displayShow (toFilePath x)
    loadMarkdownAsJSON defaultMarkdownReaderOptions defaultHtml5WriterOptions x

  readRawSingle <- newCache $ readMD >=> parseValue' rawSingleJsonFormat
  readRawPost   <- newCache $ readMD >=> parseValue' rawPostJsonFormat
  readRawDoc    <- newCache $ readMD >=> parseValue' rawDocJsonFormat

  readStage1Post <- newCache $ readRawPost >=> stage1Post
  readStage1Doc  <- newCache $ readRawDoc  >=> stage1Doc

  postIx' <- newCache $ \() -> batchLoadIndex' (Proxy @[Tag, Posted, YearMonth]) readStage1Post sourceFolder ["posts/*.md"]

  void $ addOracle        defaultIndexRoots
  void $ addOracleCache $ \y -> postIx' () >>= \x -> defaultIndexPages x postsPerPage y

  let correspondingMD   = withMdExtension . (sourceFolder </>)
      getDoc            = correspondingMD >=> readStage1Doc

  void $ addOracleCache $ \(BlogNav ())     -> LT.toStrict . renderText <$> ((commuteHtmlT . genBlogNav "Blog" defaultPrettyMonthFormat) =<< postIx' ())
  void $ addOracleCache $ \(DocNav ())      -> LT.toStrict . renderText . genDocNav  <$> mapM getDoc tableOfContents
  void $ addOracleCache $ \(RecentPosts ()) -> take numRecentPosts . Ix.toDescList (Proxy @Posted) <$> postIx' ()

  "index.html" /%> \(dir, fp) -> do
    v   <- readRawSingle =<< correspondingMD fp
    xs  <- askOracle $ RecentPosts ()
    let (v' :: TMain) = Val $ xs :*: enrichPage v
    buildPageAction' sourceFolder v' mainPageJsonFormat $ dir </> fp

  "posts/*.html" /%> \(dir, fp) -> do
    src <- correspondingMD fp
    xs  <- postIx' () >>= Ix.toZipperDesc (Proxy @Posted) >>= seekOnThrow (view fSrcPath) src
    nav <- askOracle $ BlogNav ()
    let (v :: TPost) = Val $ nav :*: enrichPage (extract xs)
    buildPageAction' sourceFolder v finalPostJsonFormat $ dir </> fp

  sequence_ $ tableOfContents =>> \xs ->
    (toFilePath . extract $ xs) /%> \(dir, fp) -> do
      nav  <- askOracle $ DocNav ()
      subs <- mapM getDoc (fmap extract . unwrap $ xs)
      v    <- getDoc fp
      let (v' :: TDoc) = Val $ nav :*: subs :*: enrichPage v
      buildPageAction' sourceFolder v' finalDocJsonFormat $ dir </> fp

  let buildPostIndex title query pageno out = do
        nav <- askOracle $ BlogNav ()
        xs  <- askOracle query
        xs' <- zipper' $ sortOn (Down . view fPageNo) xs
        let links = fmap (\x ->  T.pack (show (view fPageNo x)) :*: view fUrl x :*: RNil) (unzipper xs')
        let (v :: TPostIndex) = Val $ enrichPage (links :*: nav :*: title :*: extract (seek (pageno - 1) xs'))
        buildPageAction' sourceFolder v postIndexPageJsonFormat out

  "posts/pages/*/index.html" /%> \(dir, fp) -> do
    let n = read . (!! 2) $ splitPath fp
    buildPostIndex "Posts" (IndexPages AllPosts) n $ dir </> fp

  "posts/tags/*/pages/*/index.html" /%> \(dir, fp) -> do
    let fp' = splitPath fp
    let t = T.pack $ fp' !! 2
    let n = read   $ fp' !! 4
    buildPostIndex ("Posts tagged " <> t) (IndexPages (ByTag (Tag t))) n $ dir </> fp

  "posts/months/*/pages/*/index.html" /%> \(dir, fp) -> do
    let out' = splitPath fp
    let t  = parseISODateTime $ T.pack $ out' !! 2
    let t' = YearMonth $ toYearMonthPair t
    let n  = read $ out' !! 4
    buildPostIndex ("Posts from " <> defaultPrettyMonthFormat t) (IndexPages $ ByYearMonth t') n $ dir </> fp

  ["posts/index.html", "posts/tags/*/index.html", "posts/months/*/index.html"] /|%> \(dir, fp) -> do
    copyFileChanged (dir </> parent fp </> $(mkRelFile "pages/1/index.html")) (dir </> fp)

  ["css//*", "js//*", "webfonts//*", "images//*"] /|%> \(dir, fp) ->
    copyFileChanged (sourceFolder </> fp) (dir </> fp)

  "sitemap.xml" /%> \(dir, fp) -> do
    xs <- postIx' ()
    let xs' = Ix.toDescList (Proxy @Posted) xs
    buildSitemap (asSitemapUrl baseUrl <$> xs') $ dir </> fp

  let simplePipeline f = getDirectoryFiles sourceFolder >=> mapM f >=> needIn outputFolder
      verbatimPipeline = simplePipeline return

  phony "statics" $ verbatimPipeline ["css//*", "js//*", "webfonts//*", "images//*"]

  phony "index"   $ needIn outputFolder [$(mkRelFile "index.html")]

  phony "docs"    $ mapM withHtmlExtension tableOfContents >>= needIn outputFolder

  phony "posts"   $ simplePipeline withHtmlExtension ["posts/*.md"]

  let phonyIndex x = do
        k  <- askOracle $ IndexRoot x
        ps <- askOracle $ IndexPages x
        xs <- mapM fromGroundedUrlD $ k : (view fUrl <$> ps)
        needIn outputFolder $ fmap (</> $(mkRelFile "index.html")) xs

  phony "post-index" $ do
     phonyIndex AllPosts
     xs <- postIx' ()
     forM_ (Ix.indexKeys xs) $ \t -> phonyIndex $ ByTag t
     forM_ (Ix.indexKeys xs) $ \t -> phonyIndex $ ByYearMonth t

  phony "clean" $ do
    logInfo $ "Cleaning files in " <> displayShow outputFolder
    removeFilesAfter outputFolder ["//*"]

  phony "sitemap" $ needIn outputFolder [$(mkRelFile "sitemap.xml")]

  phony "all" $ need ["index", "posts", "post-index", "docs", "statics", "sitemap"]

tests :: [FilePath] -> TestTree
tests xs = testGroup "Rendering Tests" $
  map (\x -> goldenVsFile x x (replace "golden" "public" x) (return ())) xs where
    replace fr to' = intercalate to' . splitOn fr

main :: IO ()
main = do
   runSimpleShakePlus outputFolder $ want ["clean"] >> rules
   runSimpleShakePlus outputFolder $ want ["all"]   >> rules
   findByExtension [".html", ".xml"] "test/golden" >>= defaultMain . tests