Text.hs

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

-- | Text of the values of a ReOC, as the documents write it.
module ReOC.Render.Text (
  get,
  escapeXml,
  listing,
  andList,
  monthText,
  dayParts,
  versionText,
  quantity,
  percentageText,
  backupIntervalText,
  stateAbbreviation,
  addressText,
  legalName,
  rpaCategoryText,
  rpaCategoryProse,
  weightText,
) where

import Control.Lens (ALens', cloneLens, view)
import Data.List.NonEmpty (toList)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Calendar.Month (Month)
import qualified Data.Time.Calendar.Month as Month
import Numeric.Natural (Natural)
import ReOC.Data.Address (Address)
import ReOC.Data.AustralianState (AustralianState (..))
import ReOC.Data.BackupInterval (BackupInterval (..))
import ReOC.Data.Company (Company)
import ReOC.Data.RPACategory (RPACategory (..))
import ReOC.Data.Version (Version)
import ReOC.Name.CompanyName (CompanyNameLike (..))
import ReOC.Name.MajorVersion (MajorVersionLike (..))
import ReOC.Name.MinorVersion (MinorVersionLike (..))
import ReOC.Name.Postcode (PostcodeLike (..))
import ReOC.Name.StateOrTerritory (StateOrTerritoryLike (..))
import ReOC.Name.StreetAddress (StreetAddressLike (..))
import ReOC.Name.Suburb (SuburbLike (..))
import ReOC.Primitive.FormText (formTextText)
import ReOC.Primitive.Percentage (Percentage, percentageNatural)
import ReOC.Primitive.Positive (Positive, positiveNatural)
import ReOC.Primitive.Postcode (postcodeText)
import ReOC.Primitive.Text1 (text1Text)

{- $setup
>>> :set -XOverloadedStrings
>>> import Control.Lens (preview)
>>> import ReOC.Primitive.Positive (_Positive)
-}

-- | Reads one value through a lens (the classy optics recipe, 8).
get :: ALens' s a -> s -> a
get l =
  view (cloneLens l)

{- | Escapes text for XML.

>>> escapeXml "Q&A <today>"
"Q&amp;A &lt;today&gt;"
-}
escapeXml :: Text -> Text
escapeXml =
  Text.concatMap
    ( \case
        '&' -> "&amp;"
        '<' -> "&lt;"
        '>' -> "&gt;"
        '"' -> "&quot;"
        '\'' -> "&apos;"
        c -> Text.singleton c
    )

{- | A list in prose, with a serial comma.

>>> listing ["a"]
"a"

>>> listing ["a", "b"]
"a and b"

>>> listing ["a", "b", "c"]
"a, b, and c"
-}
listing :: [Text] -> Text
listing = \case
  [] -> ""
  [a] -> a
  [a, b] -> a <> " and " <> b
  xs -> Text.intercalate ", " (init xs) <> ", and " <> last xs

{- | A list in prose, without a serial comma.

>>> andList ["CEO", "CRP", "MC"]
"CEO, CRP and MC"
-}
andList :: [Text] -> Text
andList = \case
  [] -> ""
  [a] -> a
  xs -> Text.intercalate ", " (init xs) <> " and " <> last xs

{- | A month and year.

>>> monthText (Month.YearMonth 2026 10)
"October 2026"
-}
monthText :: Month -> Text
monthText (Month.YearMonth y m) =
  Text.pack (monthName m <> " " <> show y)
 where
  monthName n =
    case drop (n - 1) months of
      x : _ -> x
      [] -> show n
  months =
    ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]

-- | The day, month and year of a date, each with two or four digits.
dayParts :: Day -> (Text, Text, Text)
dayParts d =
  let (y, m, dd) = toGregorian d
      two n = Text.justifyRight 2 '0' (Text.pack (show n))
   in (two dd, two m, Text.pack (show y))

-- | A version, such as @1.0@.
versionText :: Version -> Text
versionText v =
  Text.pack (show (get majorVersion v) <> "." <> show (get minorVersion v))

{- | A number of things, in the singular or the plural.

>>> quantity "day" "days" <$> preview _Positive 1
Just "1 day"
-}
quantity :: Text -> Text -> Positive -> Text
quantity one many n =
  let k = positiveNatural n
   in Text.pack (show k) <> " " <> (if k == 1 then one else many)

-- | A percentage, such as @30%@.
percentageText :: Percentage -> Text
percentageText p =
  Text.pack (show (percentageNatural p)) <> "%"

-- | The interval between backups, as an adverb.
backupIntervalText :: BackupInterval -> Text
backupIntervalText = \case
  Daily -> "daily"
  Weekly -> "weekly"
  Monthly -> "monthly"

-- | The abbreviation of a state or territory.
stateAbbreviation :: AustralianState -> Text
stateAbbreviation = \case
  NewSouthWales -> "NSW"
  Victoria -> "VIC"
  Queensland -> "QLD"
  WesternAustralia -> "WA"
  SouthAustralia -> "SA"
  Tasmania -> "TAS"
  AustralianCapitalTerritory -> "ACT"
  NorthernTerritory -> "NT"

-- | An address on one line.
addressText :: Address -> Text
addressText a =
  Text.intercalate ", " (map text1Text (toList (get streetAddress a)))
    <> ", "
    <> text1Text (get suburb a)
    <> " "
    <> stateAbbreviation (get stateOrTerritory a)
    <> " "
    <> postcodeText (get postcode a)

-- | The legal name of a company: its name followed by @Pty Ltd@.
legalName :: Company -> Text
legalName c =
  formTextText (get companyName c) <> " Pty Ltd"

-- | A category of RPA, as CASA Form 101-02 writes it.
rpaCategoryText :: RPACategory -> Text
rpaCategoryText = \case
  Aeroplane -> "Aeroplane"
  Helicopter -> "Helicopter"
  Multirotor -> "Multirotor"
  PoweredLift -> "Powered-lift"

-- | A category of RPA, in prose.
rpaCategoryProse :: RPACategory -> Text
rpaCategoryProse =
  Text.toLower . rpaCategoryText

-- | A weight in grams, such as @1999 g@.
weightText :: Natural -> Text
weightText g =
  Text.pack (show g) <> " g"