{- | Small pure text helpers shared across the codebase, so the blank-value and
URL-path-join idioms have a single definition rather than several near-identical
re-spellings -- plus the hot-path ISO-8601 instant renderer the serve path uses
('renderIso8601Utc'). This module depends on nothing else in @Ecluse@, so any
module may import it without risking an import cycle.
-}
module Ecluse.Core.Text (
    nonBlank,
    stripTrailingSlash,
    joinUrlPath,
    renderIso8601Utc,
) where

import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TB
import Data.Text.Lazy.Builder.Int qualified as TBI
import Data.Time (UTCTime (UTCTime), diffTimeToPicoseconds, toGregorian)
import Data.Time.Format.ISO8601 (iso8601Show)

{- | The text trimmed of surrounding whitespace, or 'Nothing' when nothing remains.
A value that is empty or all-whitespace is treated as absent -- the idiom an
environment lookup or an optional configuration field wants for "present but blank
means unset". The surviving text is returned __trimmed__, so a caller never has to
strip it a second time.
-}
nonBlank :: Text -> Maybe Text
nonBlank :: Text -> Maybe Text
nonBlank Text
t =
    let trimmed :: Text
trimmed = Text -> Text
T.strip Text
t
     in if Text -> Bool
T.null Text
trimmed then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
trimmed

{- | Drop a single trailing @\'\/\'@ from a URL base when present, leaving any other
base untouched. At most one slash is removed, and the function is idempotent on a
base that already carries none.
-}
stripTrailingSlash :: Text -> Text
stripTrailingSlash :: Text -> Text
stripTrailingSlash Text
b = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
b (Text -> Text -> Maybe Text
T.stripSuffix Text
"/" Text
b)

{- | Join a URL base and an already-encoded path with exactly one @\'\/\'@, tolerating
one trailing slash on the base so the join never doubles it. The path is appended
verbatim -- this neither encodes nor validates it.
-}
joinUrlPath :: Text -> Text -> Text
joinUrlPath :: Text -> Text -> Text
joinUrlPath Text
b Text
path = Text -> Text
stripTrailingSlash Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path

{- | Render a 'UTCTime' as the ISO-8601 instant 'iso8601Show' produces,
__byte-for-byte__, at a fraction of the allocation cost: a handful of digit
writes into a builder instead of the general @time@ formatting machinery. The
packument serve path re-renders one instant per surviving version per request
(the served @time@ map is rebuilt from the merge plan's normalised instants), so
the formatter sits on a hot loop where the general machinery's cost is paid
thousands of times per request.

The fast path covers the whole real-world domain: years 0-9999 and a
time-of-day below 86 400 s. An input outside it (an expanded-representation
year, a leap-second reading) __delegates to 'iso8601Show' itself__, so parity is
total by construction and property-tested byte-for-byte in @TextSpec@. The
fractional second renders exactly as @iso8601Show@ does: omitted when zero, else
the picosecond digits with trailing zeros trimmed.
-}
renderIso8601Utc :: UTCTime -> Text
renderIso8601Utc :: UTCTime -> Text
renderIso8601Utc t :: UTCTime
t@(UTCTime Day
day DiffTime
dt)
    | Integer
year Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
year Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
9999 Bool -> Bool -> Bool
|| Integer
picos Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
86_400_000_000_000_000 = String -> Text
forall a. ToText a => a -> Text
toText (UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
t)
    | Bool
otherwise =
        LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
            MonthOfYear -> Integer -> Builder
digits MonthOfYear
4 Integer
year
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-"
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MonthOfYear -> Integer -> Builder
digits MonthOfYear
2 (MonthOfYear -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
month)
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-"
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MonthOfYear -> Integer -> Builder
digits MonthOfYear
2 (MonthOfYear -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
dayOfMonth)
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"T"
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MonthOfYear -> Integer -> Builder
digits MonthOfYear
2 Integer
hh
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MonthOfYear -> Integer -> Builder
digits MonthOfYear
2 Integer
mm
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MonthOfYear -> Integer -> Builder
digits MonthOfYear
2 Integer
ss
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fraction
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"Z"
  where
    (Integer
year, MonthOfYear
month, MonthOfYear
dayOfMonth) = Day -> (Integer, MonthOfYear, MonthOfYear)
toGregorian Day
day
    picos :: Integer
picos = DiffTime -> Integer
diffTimeToPicoseconds DiffTime
dt
    (Integer
secondsOfDay, Integer
frac) = Integer
picos Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
1_000_000_000_000
    (Integer
hh, Integer
rem') = Integer
secondsOfDay Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
3600
    (Integer
mm, Integer
ss) = Integer
rem' Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
60

    -- A non-negative integer, zero-padded to at least the given width (the
    -- inputs here never exceed it).
    digits :: Int -> Integer -> TB.Builder
    digits :: MonthOfYear -> Integer -> Builder
digits MonthOfYear
width Integer
n =
        let body :: String
body = Integer -> String
forall b a. (Show a, IsString b) => a -> b
show Integer
n :: String
            pad :: MonthOfYear
pad = MonthOfYear
width MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
- String -> MonthOfYear
forall a. [a] -> MonthOfYear
forall (t :: * -> *) a. Foldable t => t a -> MonthOfYear
length String
body
         in String -> Builder
TB.fromString (MonthOfYear -> Char -> String
forall a. MonthOfYear -> a -> [a]
replicate MonthOfYear
pad Char
'0') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
forall a. Integral a => a -> Builder
TBI.decimal Integer
n

    -- The fractional second as @iso8601Show@ renders it: nothing when zero,
    -- else a dot and the 12 picosecond digits with trailing zeros trimmed.
    fraction :: TB.Builder
    fraction :: Builder
fraction
        | Integer
frac Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Builder
forall a. Monoid a => a
mempty
        | Bool
otherwise =
            Text -> Builder
TB.fromText (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') (MonthOfYear -> Char -> Text -> Text
T.justifyRight MonthOfYear
12 Char
'0' (Integer -> Text
forall b a. (Show a, IsString b) => a -> b
show Integer
frac)))