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 (..), NumberLiteral (..))
import Language.Fluent.Number (NumberOptions (..), Style (..))
import Language.Fluent.Number qualified as Number
import Language.Fluent.Pattern (Pattern (..), PatternElement (..))
import Language.Fluent.Pattern qualified as Pattern
import Language.Fluent.Time (Digits, TimeOptions (..))
import Language.Fluent.Value (SomeValue (..))
import Language.Fluent.Width (Width)
import Text.Read (readMaybe)
import Prelude

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

-- | @NUMBER($ratio, minimumFractionDigits: 2)@
number :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern
number positional args = do
    given <- maybeToEither "NUMBER: expected one positional argument" $ lone positional
    case given of
        NumberValue value opts -> do
            change <- changes numberOption args
            pure . Pattern.fromValue . NumberValue value $ appEndo change opts
        _ -> Left "NUMBER: the positional argument is not a number"
  where
    numberOption :: Identifier -> SomeValue -> Either String (Endo NumberOptions)
    numberOption (Identifier name) (asText -> text) = case name of
        "style" -> case text of
            "decimal" -> set (\it options -> options{style = it}) $ Right Decimal
            "percent" -> set (\it options -> options{style = it}) $ Right Percent
            "currency" -> Right mempty
            "unit" -> Right mempty
            it -> Left $ "NUMBER: no such style: " <> Text.unpack it
        "currency" -> set (\it options -> options{style = Currency it}) $ Right text
        "currencyDisplay" -> set (\it options -> options{currencyDisplay = it}) parsed
        "unit" -> set (\it options -> options{style = Unit it}) $ Right text
        "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 SomeValue -> Either String Pattern
datetime positional args = do
    given <- maybeToEither "DATETIME: expected one positional argument" $ lone positional
    case given of
        TimeValue value opts -> do
            change <- changes timeOption args
            pure . Pattern.fromValue . TimeValue value $ appEndo change opts
        _ -> Left "DATETIME: the positional argument is not a time"
  where
    timeOption :: Identifier -> SomeValue -> 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 -> SomeValue -> Either String (Endo options))
    -> HashMap Identifier SomeValue
    -> 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 SomeValue
lone [Pattern (Value it :| [])] = Just it
lone _ = Nothing

asText :: SomeValue -> Text
asText (StringValue it) = it
asText (NumberValue it options) | NumberLiteral text <- Number.toLiteral it options = text
asText (TimeValue it _) = Text.show it
asText SomeValue{} = ""

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