Value.hs

module Language.Fluent.Value where

import Data.Int (Int16, Int32, Int64, Int8)
import Data.List.NonEmpty (NonEmpty)
import Data.Scientific (Scientific)
import Data.Scientific qualified as Scientific
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (UTCTime)
import Data.Word (Word16, Word32, Word64, Word8)
import Language.Fluent.AST (NumberLiteral (..))
import Language.Fluent.Locale (Locale (..))
import Language.Fluent.Number (NumberOptions, numberOptions)
import Language.Fluent.Number qualified as Number
import Language.Fluent.Time (TimeOptions, timeOptions)
import Numeric.Natural (Natural)
import Text.Read (readMaybe)
import Prelude hiding (fromIntegral)
import Prelude qualified

-- | The concrete representation of a Fluent value, along with any formatting options.
data Value
    = -- | A value with custom locale-aware formatting logic.
      Formatted (forall l. (Locale l) => NonEmpty l -> Either String Text)
    | -- | Text that is already formatted.
      String Text
    | -- | A number and its formatting options.
      Number Scientific NumberOptions
    | -- | A point in time and its formatting options.
      Time UTCTime TimeOptions
    | -- | A failed or invalid argument and the error reason.
      Invalid String

instance IsString Value where fromString = toValue

instance Show Value where
    show Formatted{} = "Formatted"
    show (String t) = "String " <> show t
    show (Number n _) = "Number " <> show n
    show (Time t _) = "Time " <> show t
    show (Invalid s) = "Invalid " <> show s

-- | Renders a 'Value' into text for the given locale fallback chain.
format :: (Locale l) => NonEmpty l -> Value -> Either String Text
format locales (Formatted f) = f locales
format _ (String s) = Right s
format locales (Number n o) = formatNumber locales n o
format locales (Time t o) = formatTime locales t o
format _ (Invalid reason) = Left reason

-- | The raw string representation of a 'Value' without applying locale formatting.
asText :: Value -> Text
asText Formatted{} = ""
asText (String it) = it
asText (Number it options) | NumberLiteral text <- Number.toLiteral it options = text
asText (Time it _) = Text.show it
asText (Invalid reason) = Text.pack reason

-- | Whether a selector matches a variant key by exact equality.
matchesExact :: Value -> Value -> Bool
matchesExact (String a) (String b) = a == b
matchesExact (Number a _) (Number b _) = a == b
matchesExact _ _ = False

-- | Whether a numeric selector matches a plural category key (e.g. @1@ matching @"one"@).
matchesCategory :: (Locale l) => l -> Value -> Value -> Bool
matchesCategory locale (Number n options) (String name) =
    Just (pluralCategory locale n options) == readMaybe (Text.unpack name)
matchesCategory _ _ _ = False

-- | Converts an integer into an arbitrary-precision numeric 'Value'.
fromIntegral :: (Integral a) => a -> Value
fromIntegral = toValue @Scientific . Prelude.fromIntegral

-- | Converts a floating-point number into an arbitrary-precision numeric 'Value'.
-- Evaluates to 'Invalid' for NaN and infinities.
fromFloatDigits :: (RealFloat a) => a -> Value
fromFloatDigits x
    | isNaN x = Invalid "NaN"
    | isInfinite x = Invalid $ if x < 0 then "-Infinity" else "Infinity"
    | otherwise = toValue $ Scientific.fromFloatDigits x

-- | Types usable as arguments in Fluent message formatting.
class ToValue v where toValue :: v -> Value

instance ToValue Value where toValue = id

instance ToValue Text where toValue = String

instance ToValue String where toValue = String . Text.pack

instance ToValue Scientific where toValue = flip Number numberOptions

instance ToValue Int where toValue = fromIntegral

instance ToValue Int8 where toValue = fromIntegral

instance ToValue Int16 where toValue = fromIntegral

instance ToValue Int32 where toValue = fromIntegral

instance ToValue Int64 where toValue = fromIntegral

instance ToValue Integer where toValue = fromIntegral

instance ToValue Word where toValue = fromIntegral

instance ToValue Word8 where toValue = fromIntegral

instance ToValue Word16 where toValue = fromIntegral

instance ToValue Word32 where toValue = fromIntegral

instance ToValue Word64 where toValue = fromIntegral

instance ToValue Natural where toValue = fromIntegral

instance ToValue Float where toValue = fromFloatDigits

instance ToValue Double where toValue = fromFloatDigits

instance ToValue UTCTime where toValue = flip Time timeOptions