packages feed

casa-reoc-0.1.0.0: src/ReOC/Render/TrainingManual/Body.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}

{- | The body of the RePL training manual: the marked-up text of
@template/repl-training-manual.md@, read when the package is compiled, with
its holes filled, each @per-course@ block repeated for each course, and each
condition decided; then its markdown as Flat ODF text.
-}
module ReOC.Render.TrainingManual.Body (
  trainingMarkdown,
  holeBody,
  holeContents,
) where

import Data.Foldable (toList)
import Data.Text (Text)
import qualified Data.Text as Text
import ReOC.Model
import ReOC.Render.Markdown (parseMarkdown, renderBlocks)
import ReOC.Render.Text (get)
import ReOC.Render.TrainingManual.Chunk (Chunk (..))
import ReOC.Render.TrainingManual.Embed (embedMarkup)
import ReOC.Render.TrainingManual.Holes (courseHoles, courseProperty, offered, trainingHoles)

markup :: [Chunk]
markup =
  $(embedMarkup "template/repl-training-manual.md")

{- | The markdown of the RePL training manual. Every hole has a value and every
condition is known, which 'embedMarkup' checked when the package was compiled.
-}
trainingMarkdown :: ReOC -> TrainingMaterial -> Text
trainingMarkdown r t =
  Text.concat (map (chunk Nothing) markup)
 where
  chunk course = \case
    Literal x -> x
    Hole n ->
      case (lookup n trainingHoles, course >>= \c -> fmap ($ c) (lookup n courseHoles)) of
        (Just f, _) -> f r t
        (_, Just v) -> v
        _ -> ""
    CourseCondition k v cs ->
      if maybe False (elem v . courseProperty k) course then Text.concat (map (chunk course) cs) else ""
    OfferedCondition k v cs ->
      if offered t k v then Text.concat (map (chunk course) cs) else ""
    SimulatorCondition cs ->
      maybe "" (const (Text.concat (map (chunk course) cs))) (get (trainingArrangements . simulator) t)
    PerCourse cs ->
      Text.concat [Text.concat (map (chunk (Just c)) cs) | c <- toList (get trainingCourses t)]

rendered :: ReOC -> (Text, Text)
rendered r =
  maybe ("", "") (renderBlocks . parseMarkdown . trainingMarkdown r) (get maybeTrainingMaterial r)

-- | The body of the manual.
holeBody :: ReOC -> Text
holeBody =
  fst . rendered

-- | The entries of the table of contents of the manual.
holeContents :: ReOC -> Text
holeContents =
  snd . rendered