packages feed

casa-reoc-0.1.0.0: src/ReOC/Render/ApplicationForm.hs

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

{- | CASA Form 101-02, RPA Operator's Certificate (ReOC) - initial issue /
variation / renewal, filled from a 'ReOC' as XFDF.

Every answer comes from the value: the application type is always initial
issue, the ReOC number is blank, and the questions that the form's own flow
skips (question 3 when the applicant is the primary contact, questions 13 to
18 and 29 without RePL training, questions 25 and 26 without regulatory
action) are not filled.

The declaration date is left as the placeholders @${DECLARATION_DAY}@,
@${DECLARATION_MONTH}@ and @${DECLARATION_YEAR}@, which the document build
replaces with the date of the build.
-}
module ReOC.Render.ApplicationForm (
  renderApplicationForm,
  applicationFormFields,
) where

import Data.Foldable (toList)
import Data.List (nub)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as Text
import ReOC.Aircraft (rpaName, rpaTypes)
import ReOC.Model
import ReOC.Personnel (nominatedCEO, nominatedCRI, nominatedCRP, nominatedMC)
import ReOC.Render.BlankForm (blankFormFile)
import ReOC.Render.Text (dayParts, escapeXml, get, legalName, rpaCategoryText, weightText)

-- | The fields of the form, by question: a comment, and the name and value of each field.
applicationFormFields :: ReOC -> [(Text, [(Text, Text)])]
applicationFormFields r =
  let c = get (operator . company) r
      kp = get (operator . keyPersonnel) r
      ceo = get person (nominatedCEO kp)
      cp = get chiefPilot kp
      af = get applicationForm r
      training = get maybeTrainingMaterial r
      personFields :: Text -> Person -> (Text, Text, Text, Text) -> (Text, [(Text, Text)])
      personFields prefix p (nameF, arnF, phoneF, emailF) =
        ( prefix
        ,
          [ (nameF, formTextText (get fullName p))
          , (arnF, arnText (get arn p))
          , (phoneF, phoneNumberText (get phoneNumber p))
          , (emailF, emailAddressText (get emailAddress p))
          ]
        )
      yesNo q = \case
        True -> ("Q" <> q <> " Check Yes", "Yes")
        False -> ("Q" <> q <> " Check No", "No")
      history q a =
        case a of
          NoHistory -> [yesNo q False]
          HistoryDisclosed _ -> [yesNo q True]
      disclosed =
        [ "Q" <> q <> ": " <> formTextText d
        | (q, HistoryDisclosed d) <-
            [ ("19", get (personnelHistory . actionTaken) af)
            , ("20", get (personnelHistory . transportLicenceRefused) af)
            , ("21", get (personnelHistory . criminalConviction) af)
            , ("22", get (personnelHistory . suspensionPending) af)
            ]
        ]
      otherDocs = map formTextText (atMostList (get otherDocuments af))
   in concat
        [
          [
            ( "1 Applicant"
            ,
              [ ("Q1 Applicant Full Name", legalName c)
              , ("Q1 Applicant ARN", arnText (get arn c))
              , ("Q1 ReOC number", "")
              , ("Q1 Phone number", phoneNumberText (get phoneNumber c))
              , ("Q1 email address", emailAddressText (get emailAddress c))
              ]
            )
          ]
        , case get primaryContact af of
            ApplicantIsPrimaryContact ->
              [("2 Primary contact", [("Q2 Check Yes", "Yes")])]
            PrimaryContactPerson contact ->
              [ ("2 Primary contact", [("Q2 Check No", "No")])
              ,
                ( "3 Contact person"
                ,
                  [ ("Q3 contact full name", formTextText (get fullName contact))
                  , ("Q3 contact position", formTextText (get position contact))
                  , ("Q3 Contact Phone number", phoneNumberText (get phoneNumber contact))
                  , ("Q3 contact email", emailAddressText (get emailAddress contact))
                  ]
                )
              ]
        , [("4 Application type", [("Q4 application type 1", "Initial issue")])]
        , case get businessName c of
            Nothing ->
              [("5 Registered business name", [("Q5 Check 1", "No")])]
            Just n ->
              [ ("5 Registered business name", [("Q5 Check 2", "Add new")])
              , ("6 Registered business name to be added", [("Q6 registered Business name", formTextText n)])
              ]
        ,
          [ let (cmt, fs) =
                  personFields
                    "7 CEO/Responsible Manager"
                    ceo
                    ( "Q7 CEO/Responsible Manager Full Name"
                    , "Q7 CEO/Responsible Manager ARN"
                    , "Q7 CEO/Responsible Manager Phone number"
                    , "Q7 CEO/Responsible Manager email"
                    )
             in (cmt, fs <> maybe [] (\e -> [("Q7 Multiline", formTextText e)]) (get (chiefExecutive . managementExperience) kp))
          , personFields
              "8 Chief Remote Pilot"
              (get person (nominatedCRP kp))
              ("Q8 Chief Remote Pilot Full Name", "Q8 Chief Remote Pilot ARN", "Q8 Phone number", "Q8 email")
          ,
            ( "9 How the Chief Remote Pilot obtained the initial RePL"
            , case get rePLOrigin cp of
                PPLTheory -> [("Q9 option 1", "PPL Theory")]
                RePLTraining o -> [("Q9 option 2", "RePL Training"), ("Q9 RePL Training organisation name", formTextText o)]
            )
          , ("10 Chief Remote Pilot RPA history and experience", [("Q10 Multiline", formTextText (get rpaHistory cp))])
          ,
            ( "11 Chief Remote Pilot roles with other ReOC holders"
            , case get otherReOCRoles cp of
                NoOtherReOCRoles -> [("Q11 Check No", "No")]
                OtherReOCRolesHeld d -> [("Q11 Check Yes", "Yes"), ("Q11 Multiline", formTextText d)]
            )
          , personFields
              "12 Maintenance Controller"
              (get person (nominatedMC kp))
              ("Q12 Maintenance Controller Full Name", "Q12 Maintenance Controller ARN", "Q12 Phone number", "Q12 email")
          ]
        , maybe [] (\t -> trainingQuestions (personFields "13 Chief RePL Instructor" (get person (nominatedCRI kp t))) t) training
        ,
          [
            ( "19-23 Nominated personnel history"
            , concat
                [ history "19" (get (personnelHistory . actionTaken) af)
                , history "20" (get (personnelHistory . transportLicenceRefused) af)
                , history "21" (get (personnelHistory . criminalConviction) af)
                , history "22" (get (personnelHistory . suspensionPending) af)
                , [("Q23 Multiline", Text.intercalate "\n" disclosed) | not (null disclosed)]
                ]
            )
          ]
        , case get regulatoryHistory af of
            NoRegulatoryAction ->
              [("24 Regulatory action", [yesNo "24" False])]
            RegulatoryActionTaken a ->
              let (dd, mm, yyyy) = dayParts (get actionDate a)
               in [ ("24 Regulatory action", [yesNo "24" True])
                  , ("25 ReOC suspended or cancelled", [yesNo "25" (get reocSuspendedOrCancelled a)])
                  ,
                    ( "26 Regulatory action details"
                    ,
                      [ ("Q26 type of action", formTextText (get typeOfAction a))
                      , ("Q26 Type of authorisation action taken against you", formTextText (get authorisationAction a))
                      , ("Q26 Date the action was taken - Day", dd)
                      , ("Q26 Date the action was taken - Month", mm)
                      , ("Q26 Date the action was taken - Year", yyyy)
                      , ("Q26 Multiline", formTextText (get actionDetails a))
                      ]
                    )
                  ]
        ,
          [
            ( "27 RPA type and category"
            , concat
                [ [ (formField "check" (2 * i - 1), "Yes")
                  , (formField "cell" (3 * i - 2), rpaCategoryText (get category t))
                  , (formField "cell" (3 * i - 1), rpaName t)
                  , (formField "cell" (3 * i), weightText (grossWeightGrams (get maximumGrossWeight t)))
                  ]
                | (i, t) <- zip [1 :: Int ..] (toList (rpaTypes r))
                ]
            )
          , ("28 RePL training", [yesNo "28" (isJust training)])
          ,
            ( "30 Application checklist"
            , concat
                [ [("Q30 Checklist 1", "Yes")]
                , [("Q30 Checklist 2", "Yes") | get proceduresLibrary af]
                , maybe [] trainingChecklist training
                , [("Q30 Checklist 14", "Yes") | not (null otherDocs)]
                , [("Q17 Checklist other", Text.intercalate "\n" otherDocs) | not (null otherDocs)]
                ]
            )
          ]
        , let (declarantName, capacity) =
                case get declaration af of
                  DeclaredByCEO -> (formTextText (get fullName ceo), [("Q32 role CEO", "CEO")])
                  DeclaredByResponsibleManager n -> (formTextText n, [("Q32 role responsible manager", "Responsible Manager")])
                  DeclaredByAgent n -> (formTextText n, [("Q32 role agent", "Agent")])
                  DeclaredByOther d ->
                    (formTextText (get fullName d), [("Q32 role other", "Other"), ("Q32 other role authority", formTextText (get role d))])
           in [
                ( "31 Declaration"
                ,
                  [ ("Q31 Declaration Full Name", declarantName)
                  , ("Q31 Declaration Date - Day", "${DECLARATION_DAY}")
                  , ("Q31 Declaration Date - Month", "${DECLARATION_MONTH}")
                  , ("Q31 Declaration Date - Year", "${DECLARATION_YEAR}")
                  ]
                )
              , ("32 Capacity", capacity)
              ]
        ]
 where
  formField kind n =
    "Q27 " <> kind <> " " <> Text.pack (show n)

-- Questions 13 to 18 and 29, for RePL training, given the fields of the chief RePL instructor.
trainingQuestions :: ((Text, Text, Text, Text) -> (Text, [(Text, Text)])) -> TrainingMaterial -> [(Text, [(Text, Text)])]
trainingQuestions criFields t =
  let intents =
        concat
          [ case get rePLHolding t of
              HoldsRePLForEachType -> []
              RePLHoldingIntent i -> ["Q14: " <> formTextText i]
          , case get teachingQualification t of
              TeachingQualificationHeld _ -> []
              TeachingQualificationIntent i -> ["Q15: " <> formTextText i]
          , case get operationalExperience t of
              HasOperationalExperience -> []
              OperationalExperienceIntent i -> ["Q16: " <> formTextText i]
              OperationalExperienceNotApplicable -> []
          ]
   in [ criFields ("Q13 Chief RePL Instructor Full Name", "Q13 Chief RePL Instructor ARN", "Q13 Phone number", "Q13 email")
      ,
        ( "14-17 Chief RePL Instructor qualifications"
        , concat
            [ case get rePLHolding t of
                HoldsRePLForEachType -> [("Q14 Check Yes", "Yes")]
                RePLHoldingIntent _ -> [("Q14 Check No", "No")]
            , case get teachingQualification t of
                TeachingQualificationHeld d -> [("Q15 Check Yes", "Yes"), ("Q15 Provide details of qualifications", formTextText d)]
                TeachingQualificationIntent _ -> [("Q15 Check No", "No")]
            , case get operationalExperience t of
                HasOperationalExperience -> [("Q16 Check Yes", "Yes")]
                OperationalExperienceIntent _ -> [("Q16 Check No", "No")]
                OperationalExperienceNotApplicable -> [("Q16 Check Not applicable ", "Not applicable")]
            , [("Q17 Multiline", Text.intercalate "\n" intents) | not (null intents)]
            ]
        )
      ,
        ( "18 Chief RePL Instructor roles with other ReOC holders"
        , case get criOtherReOCRoles t of
            NoOtherReOCRoles -> [("Q18 Check No", "No")]
            OtherReOCRolesHeld d -> [("Q18 Check yes", "Yes"), ("Q18 Multiline", formTextText d)]
        )
      , ("29 RePL training courses", concat (zipWith courseRow [1 ..] (toList (get trainingCourses t))))
      ]
 where
  -- A row of question 29: the category and weight class are those of the course's training RPA.
  courseRow :: Int -> TrainingCourse -> [(Text, Text)]
  courseRow i c =
    let base = 16 * (i - 1)
        check k = "Q29 check " <> Text.pack (show (base + k))
        on k = (check k, "Yes")
        rpa = get (trainingRPA . rpaType) c
     in concat
          [ [(check 1, if i == 1 then "add" else "Yes")]
          ,
            [ on $ case get courseKind c of
                InitialCourse -> 3
                UpgradeSameCategory -> 4
                UpgradeDifferentCategory -> 5
            ]
          ,
            [ on $ case get category rpa of
                Multirotor -> 6
                Helicopter -> 7
                PoweredLift -> 8
                Aeroplane -> 9
            ]
          , [on (if grossWeightGrams (get maximumGrossWeight rpa) <= 7000 then 10 else 11)]
          , [("Q29 cell " <> Text.pack (show i), rpaName rpa)]
          , nub
              [ on $ case x of
                AutomatedAndManual -> 14
                AutomatedOnly -> 15
              | x <- toList (get complexities c)
              ]
          ]

-- Question 30, items 3 to 12: the RePL training documents, all of which the RePL training manual holds. A
-- safety case (item 13) is for medium and large RPA, which the operations manual does not cover.
trainingChecklist :: TrainingMaterial -> [(Text, Text)]
trainingChecklist _ =
  [("Q30 Checklist " <> Text.pack (show k), "Yes") | k <- [3 .. 12 :: Int]]

{- | The XFDF of CASA Form 101-02. It names the blank form by its file name
('blankFormFile'), which 'ReOC.Render.Write.writeDocuments' writes beside it.
-}
renderApplicationForm :: ReOC -> Text
renderApplicationForm r =
  Text.unlines $
    [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
    , "<xfdf xmlns=\"http://ns.adobe.com/xfdf/\" xml:space=\"preserve\">"
    , "  <f href=\"" <> escapeXml (Text.pack blankFormFile) <> "\"/>"
    , "  <fields>"
    ]
      <> concatMap question (applicationFormFields r)
      <> [ "  </fields>"
         , "</xfdf>"
         ]
 where
  question (cmt, fs) =
    ("    <!-- " <> cmt <> " -->")
      : [ "    <field name=\"" <> escapeXml n <> "\"><value>" <> escapeXml v <> "</value></field>"
        | (n, v) <- fs
        ]