Function.hs

module Language.Fluent.Function where

import Data.Either.Extra (maybeToEither)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty (..))
import Data.Monoid (Endo (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Language.Fluent.AST (Identifier (..))
import Language.Fluent.Number (NumberOptions (..), Style (..))
import Language.Fluent.Pattern (Pattern (..), PatternElement (..))
import Language.Fluent.Pattern qualified as Pattern
import Language.Fluent.Time (Digits, TimeOptions (..))
import Language.Fluent.Value (Value, asText)
import Language.Fluent.Value qualified as Value
import Language.Fluent.Width (Width)
import Text.Read (readMaybe)
import Prelude

builtins
    :: HashMap
        Identifier
        ( [Pattern]
          -> HashMap Identifier Value
          -> Either String Pattern
        )
builtins = HashMap.fromList [(Identifier "NUMBER", number), (Identifier "DATETIME", datetime)]

-- | @NUMBER($ratio, minimumFractionDigits: 2)@
number :: [Pattern] -> HashMap Identifier Value -> Either String Pattern
number positional args = do
    given <- maybeToEither "NUMBER: expected one positional argument" $ lone positional
    case given of
        Value.Number value opts -> do
            change <- changes numberOption args
            style <- numberStyle opts.style
            pure . Pattern.fromValue . Value.Number value $ (appEndo change opts){style}
        Value.Invalid reason -> Left reason
        _ -> Left "NUMBER: the positional argument is not a number"
  where
    option name = asText <$> HashMap.lookup (Identifier name) args

    numberStyle :: Style -> Either String Style
    numberStyle current = case (option "style", option "currency", option "unit") of
        (Just "decimal", _, _) -> Right Decimal
        (Just "percent", _, _) -> Right Percent
        (Just "currency", currency, _) ->
            maybe (Left "NUMBER: the currency style needs a currency") (Right . Currency) currency
        (Just "unit", _, unit) ->
            maybe (Left "NUMBER: the unit style needs a unit") (Right . Unit) unit
        (Just it, _, _) -> Left $ "NUMBER: no such style: " <> Text.unpack it
        (Nothing, Just currency, _) -> Right $ Currency currency
        (Nothing, Nothing, Just unit) -> Right $ Unit unit
        (Nothing, Nothing, Nothing) -> Right current

    numberOption :: Identifier -> Value -> Either String (Endo NumberOptions)
    numberOption (Identifier name) (asText -> text) = case name of
        "style" -> Right mempty
        "currency" -> Right mempty
        "unit" -> Right mempty
        "type" -> set (\it options -> options{form = it}) parsed
        "currencyDisplay" -> set (\it options -> options{currencyDisplay = it}) parsed
        "unitDisplay" -> set (\it options -> options{unitDisplay = it}) parsed
        "useGrouping" -> set (\it options -> options{useGrouping = it}) $ flag text
        "minimumIntegerDigits" ->
            set (\it options -> options{minimumIntegerDigits = it}) $ count text
        "minimumFractionDigits" ->
            set (\it options -> options{minimumFractionDigits = it}) $ count text
        "maximumFractionDigits" ->
            set (\it options -> options{maximumFractionDigits = Just it}) $ count text
        "minimumSignificantDigits" ->
            set (\it options -> options{minimumSignificantDigits = Just it}) $ count text
        "maximumSignificantDigits" ->
            set (\it options -> options{maximumSignificantDigits = Just it}) $ count text
        it -> Left $ "NUMBER: no such option: " <> Text.unpack it
      where
        parsed :: (Bounded a, Enum a, Read a, Show a) => Either String a
        parsed = named "NUMBER" name text

    count :: Text -> Either String Int
    count (Text.unpack -> it) = maybe (Left $ "not a count: " <> it) Right . readMaybe $ it

-- | @DATETIME($date, month: "long")@
datetime :: [Pattern] -> HashMap Identifier Value -> Either String Pattern
datetime positional args = do
    given <- maybeToEither "DATETIME: expected one positional argument" $ lone positional
    case given of
        Value.Time value opts -> do
            change <- changes timeOption args
            pure . Pattern.fromValue . Value.Time value $ appEndo change opts
        Value.Invalid reason -> Left reason
        _ -> Left "DATETIME: the positional argument is not a time"
  where
    timeOption :: Identifier -> Value -> Either String (Endo TimeOptions)
    timeOption (Identifier name) (asText -> text) = case name of
        "timeZone" -> set (\it options -> options{timeZone = it}) $ zone text
        "hour12" -> set (\it options -> options{hour12 = Just it}) $ flag text
        "weekday" -> set (\it options -> options{weekday = Just it}) parsed
        "era" -> set (\it options -> options{era = Just it}) parsed
        "year" -> set (\it options -> options{year = Just it}) parsed
        "month" -> set (\it options -> options{month = Just it}) monthField
        "day" -> set (\it options -> options{day = Just it}) parsed
        "hour" -> set (\it options -> options{hour = Just it}) parsed
        "minute" -> set (\it options -> options{minute = Just it}) parsed
        "second" -> set (\it options -> options{second = Just it}) parsed
        "timeZoneName" -> set (\it options -> options{timeZoneName = Just it}) parsed
        it -> Left $ "DATETIME: no such option: " <> Text.unpack it
      where
        parsed :: (Bounded a, Enum a, Read a, Show a) => Either String a
        parsed = named "DATETIME" name text
        monthField
            | Right digits <- parsed @Digits = Right $ Left digits
            | Right width <- parsed @Width = Right $ Right width
            | otherwise = Left $ "DATETIME: no such month: " <> Text.unpack text

    zone :: Text -> Either String Text
    zone "" = Left "DATETIME: the timeZone names no zone"
    zone it = Right it

changes
    :: (Identifier -> Value -> Either String (Endo options))
    -> HashMap Identifier Value
    -> Either String (Endo options)
changes option = fmap mconcat . traverse (uncurry option) . HashMap.toList

named :: forall a. (Bounded a, Enum a, Read a, Show a) => String -> Text -> Text -> Either String a
named fn (Text.unpack -> what) (Text.unpack -> text) = maybeToEither err $ readMaybe text
  where
    err =
        mconcat
            [ fn
            , ": expected one of "
            , List.intercalate ", " (show <$> [minBound @a .. maxBound])
            , " for "
            , what
            , ", but got "
            , text
            ]

set :: (a -> options -> options) -> Either String a -> Either String (Endo options)
set change = fmap $ Endo . change

lone :: [Pattern] -> Maybe Value
lone [Pattern (Value it :| [])] = Just it
lone _ = Nothing

flag :: Text -> Either String Bool
flag (Text.unpack -> it)
    | it `elem` ["true", "1"] = Right True
    | it `elem` ["false", "0"] = Right False
    | otherwise = Left $ "not a flag: " <> it