Holes.hs

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

{- | The holes of the RePL training manual. The holes of its markdown
(@template/repl-training-manual.md@) are 'trainingHoles', for the manual,
and 'courseHoles', for each course; their values are markdown. The holes of
its shell (@template/repl-training-manual.fodt@) are the functions
@hole...@, whose values are XML; the shell is only rendered with RePL
training.
-}
module ReOC.Render.TrainingManual.Holes (
  trainingHoles,
  trainingHoleNames,
  courseHoles,
  courseHoleNames,
  courseProperty,
  offered,
  holeCriName,
  holeLegalName,
  holeOrganisationArn,
  holeOrganisationName,
  holeReviewDate,
  holeVersion,
  holeVersionDate,
) where

import Data.Foldable (toList)
import Data.List (nub)
import Data.Text (Text)
import qualified Data.Text as Text
import ReOC.Aircraft (rpaName)
import ReOC.Amendment (manualDate, manualReviewDate, manualVersion)
import ReOC.Model
import ReOC.Personnel (nominatedCEO, nominatedCRI, nominatedCRP)
import ReOC.Render.Markdown (escapeMarkdown)
import ReOC.Render.Text

nameOf :: Nominee -> Text
nameOf =
  formTextText . get (person . fullName)

-- | The holes of the markdown of the manual, by name: each gives markdown.
trainingHoles :: [(Text, ReOC -> TrainingMaterial -> Text)]
trainingHoles =
  map
    (fmap (\f r t -> escapeMarkdown (f r t)))
    [ ("organisation-name", \r _ -> formTextText (get (operator . company . companyName) r))
    , ("legal-name", \r _ -> legalName (get (operator . company) r))
    , ("organisation-arn", \r _ -> arnText (get (operator . company . arn) r))
    , ("version", \r _ -> versionText (manualVersion (get operationsManual r)))
    , ("version-date", \r _ -> monthText (manualDate (get operationsManual r)))
    , ("review-date", \r _ -> monthText (manualReviewDate (get operationsManual r)))
    , ("cri-name", \r t -> nameOf (nominatedCRI (get (operator . keyPersonnel) r) t))
    , ("cri-arn", \r t -> arnText (get (person . arn) (nominatedCRI (get (operator . keyPersonnel) r) t)))
    , ("crp-name", \r _ -> nameOf (nominatedCRP (get (operator . keyPersonnel) r)))
    , ("ceo-name", \r _ -> nameOf (nominatedCEO (get (operator . keyPersonnel) r)))
    , ("independent-review-years", \r _ -> quantity "year" "years" (get (operationsManual . policies . independentReviewYears) r))
    , ("max-students-per-course", \_ t -> showPositive (get (trainingArrangements . maxStudentsPerCourse) t))
    , ("max-students-per-instructor", \_ t -> showPositive (get (trainingArrangements . maxStudentsPerInstructor) t))
    , ("exam-pass-mark", \_ t -> Text.pack (show (passMarkNatural (get (trainingArrangements . examPassMark) t))))
    , ("simulator", \_ t -> maybe "" text1Text (get (trainingArrangements . simulator) t))
    , ("instructor-takeover-method", \_ t -> takeoverText (get (trainingArrangements . takeover) t))
    , ("theory-delivery", \_ t -> theoryText (get (trainingArrangements . theory) t))
    , ("exam-delivery", \r t -> examText (formTextText (get (operator . company . companyName) r)) (get (trainingArrangements . exam) t))
    , ("flight-test-examiner", \_ t -> examinerText (get (trainingArrangements . examiner) t))
    ]
    <> [("training-location-rows", \_ t -> locationRows t)]
 where
  showPositive =
    Text.pack . show . positiveNatural
  takeoverText = \case
    DualControllerLink -> "a dual-controller (trainer) link, in which the instructor’s controller has priority and the instructor can take control with a single switch"
    SharedController -> "a single shared controller, with the instructor standing beside the student within arm’s reach and able to take the controller immediately"
  theoryText = \case
    ClassroomTheory -> "face-to-face classroom instruction"
    BlendedTheory -> "a combination of self-paced study of Part D and face-to-face classroom sessions"
    OnlineTheory -> "live online video instruction, with face-to-face review before the examination"
  examText o = \case
    PaperExamination -> "in person, on paper, at a " <> o <> " training location"
    ComputerExamination -> "in person, on a computer-based examination system at a " <> o <> " training location"
  examinerText = \case
    CRIConductsFlightTests -> "the CRI"
    IndependentExaminerWhereAvailable -> "an examiner other than the instructor who delivered most of the student’s practical training, where one is available, and otherwise by the CRI"

-- The rows of the table of training locations: each place once, with its use.
locationRows :: TrainingMaterial -> Text
locationRows t =
  let theoryPlaces = map text1Text (toList (get (trainingArrangements . theoryVenues) t))
      practical = map text1Text (toList (get (trainingArrangements . practicalAreas) t))
      row p =
        let use = case (p `elem` theoryPlaces, p `elem` practical) of
              (True, True) -> "Theory and practical"
              (True, False) -> "Theory"
              _ -> "Practical"
            notes = if p `elem` practical then "Site assessment and Flight Record IAW operations manual" else "Supervised examination area"
         in "| " <> escapeMarkdown p <> " | " <> use <> " | " <> notes <> " |"
   in Text.intercalate "\n" (map row (nub (theoryPlaces <> practical)))

-- | The names of the holes of the markdown of the manual.
trainingHoleNames :: [Text]
trainingHoleNames =
  map fst trainingHoles

-- The training RPA of a course.
courseRPA :: TrainingCourse -> RPAType
courseRPA =
  get (trainingRPA . rpaType)

-- The weight class of a course: that of its training RPA.
upTo25kg :: TrainingCourse -> Bool
upTo25kg c =
  grossWeightGrams (get maximumGrossWeight (courseRPA c)) > 7000

courseTypeText :: CourseType -> Text
courseTypeText = \case
  InitialCourse -> "Initial"
  UpgradeSameCategory -> "Upgrade (same category)"
  UpgradeDifferentCategory -> "Upgrade (different category)"

complexityText :: Complexity -> Text
complexityText = \case
  AutomatedAndManual -> "automated and manual"
  AutomatedOnly -> "automated only"

-- | The holes of the markdown of each course, by name: each gives markdown.
courseHoles :: [(Text, TrainingCourse -> Text)]
courseHoles =
  map
    (fmap (escapeMarkdown .))
    [ ("course-title", \c -> courseTypeText (get courseKind c) <> " RePL course – " <> categoryOf c <> " " <> weight c <> " (" <> complexityList c <> ")")
    , ("course-type", courseTypeText . get courseKind)
    , ("course-category", categoryOf)
    , ("course-weight-classes", weight)
    , ("course-training-rpa", rpaName . courseRPA)
    , ("course-complexity", complexityList)
    ]
 where
  categoryOf :: TrainingCourse -> Text
  categoryOf = rpaCategoryText . get category . courseRPA
  weight :: TrainingCourse -> Text
  weight c = if upTo25kg c then "up to 25 kg" else "up to 7 kg"
  complexityList :: TrainingCourse -> Text
  complexityList = listing . map complexityText . nub . toList . get complexities

-- | The names of the holes of the markdown of each course.
courseHoleNames :: [Text]
courseHoleNames =
  map fst courseHoles

-- | The values of a course for a key of a condition (see "ReOC.Render.TrainingManual.Markup").
courseProperty :: Text -> TrainingCourse -> [Text]
courseProperty k c =
  case k of
    "category" ->
      [ case get category (courseRPA c) of
          Multirotor -> "multirotor"
          Helicopter -> "helicopter"
          PoweredLift -> "powered-lift"
          Aeroplane -> "aeroplane"
      ]
    "weight" -> [if upTo25kg c then "up-to-25kg" else "up-to-7kg"]
    "complexity" ->
      [ case x of
        AutomatedAndManual -> "automated-and-manual"
        AutomatedOnly -> "automated-only"
      | x <- toList (get complexities c)
      ]
    "course-type" ->
      [ case get courseKind c of
          InitialCourse -> "initial"
          UpgradeSameCategory -> "upgrade-same-category"
          UpgradeDifferentCategory -> "upgrade-different-category"
      ]
    _ -> []

-- | Whether any course has a value for a key of a condition.
offered :: TrainingMaterial -> Text -> Text -> Bool
offered t k v =
  any (elem v . courseProperty k) (toList (get trainingCourses t))

-- The holes of the shell, which is only rendered with RePL training.
withTraining :: (ReOC -> TrainingMaterial -> Text) -> ReOC -> Text
withTraining f r =
  maybe "" (escapeXml . f r) (get maybeTrainingMaterial r)

holeCriName, holeLegalName, holeOrganisationArn, holeOrganisationName, holeReviewDate, holeVersion, holeVersionDate :: ReOC -> Text
holeCriName = withTraining (\r t -> nameOf (nominatedCRI (get (operator . keyPersonnel) r) t))
holeLegalName = escapeXml . legalName . get (operator . company)
holeOrganisationArn = escapeXml . arnText . get (operator . company . arn)
holeOrganisationName = escapeXml . formTextText . get (operator . company . companyName)
holeReviewDate = escapeXml . monthText . manualReviewDate . get operationsManual
holeVersion = escapeXml . versionText . manualVersion . get operationsManual
holeVersionDate = escapeXml . monthText . manualDate . get operationsManual