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 :: String -> Value
fromString = String -> Value
forall v. ToValue v => v -> Value
toValue

instance Show Value where
    show :: Value -> String
show Formatted{} = String
"Formatted"
    show (String Text
t) = String
"String " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
    show (Number Scientific
n NumberOptions
_) = String
"Number " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n
    show (Time UTCTime
t TimeOptions
_) = String
"Time " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTCTime -> String
forall a. Show a => a -> String
show UTCTime
t
    show (Invalid String
s) = String
"Invalid " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
s

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

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

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

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

-- | Converts an integer into an arbitrary-precision numeric 'Value'.
fromIntegral :: (Integral a) => a -> Value
fromIntegral :: forall a. Integral a => a -> Value
fromIntegral = forall v. ToValue v => v -> Value
toValue @Scientific (Scientific -> Value) -> (a -> Scientific) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Scientific
forall a b. (Integral a, Num b) => a -> b
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 :: forall a. RealFloat a => a -> Value
fromFloatDigits a
x
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = String -> Value
Invalid String
"NaN"
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = String -> Value
Invalid (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then String
"-Infinity" else String
"Infinity"
    | Bool
otherwise = Scientific -> Value
forall v. ToValue v => v -> Value
toValue (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ a -> Scientific
forall a. RealFloat a => a -> Scientific
Scientific.fromFloatDigits a
x

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

instance ToValue Value where toValue :: Value -> Value
toValue = Value -> Value
forall a. a -> a
id

instance ToValue Text where toValue :: Text -> Value
toValue = Text -> Value
String

instance ToValue String where toValue :: String -> Value
toValue = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance ToValue Scientific where toValue :: Scientific -> Value
toValue = (Scientific -> NumberOptions -> Value)
-> NumberOptions -> Scientific -> Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Scientific -> NumberOptions -> Value
Number NumberOptions
numberOptions

instance ToValue Int where toValue :: Int -> Value
toValue = Int -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Int8 where toValue :: Int8 -> Value
toValue = Int8 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Int16 where toValue :: Int16 -> Value
toValue = Int16 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Int32 where toValue :: Int32 -> Value
toValue = Int32 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Int64 where toValue :: Int64 -> Value
toValue = Int64 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Integer where toValue :: Integer -> Value
toValue = Integer -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Word where toValue :: Word -> Value
toValue = Word -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Word8 where toValue :: Word8 -> Value
toValue = Word8 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Word16 where toValue :: Word16 -> Value
toValue = Word16 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Word32 where toValue :: Word32 -> Value
toValue = Word32 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Word64 where toValue :: Word64 -> Value
toValue = Word64 -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Natural where toValue :: Natural -> Value
toValue = Natural -> Value
forall a. Integral a => a -> Value
fromIntegral

instance ToValue Float where toValue :: Float -> Value
toValue = Float -> Value
forall a. RealFloat a => a -> Value
fromFloatDigits

instance ToValue Double where toValue :: Double -> Value
toValue = Double -> Value
forall a. RealFloat a => a -> Value
fromFloatDigits

instance ToValue UTCTime where toValue :: UTCTime -> Value
toValue = (UTCTime -> TimeOptions -> Value)
-> TimeOptions -> UTCTime -> Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> TimeOptions -> Value
Time TimeOptions
timeOptions