module Language.Fluent.Pattern where

import Control.Monad.Extra (mconcatMapM)
import Data.Either (partitionEithers)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (listToMaybe)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Language.Fluent.AST (Identifier)
import Language.Fluent.AST qualified as AST
import Language.Fluent.Locale (Locale (..))
import Language.Fluent.Number qualified as Number
import Language.Fluent.Value (CustomValue (..), SomeValue (..), Value (..))
import Text.Read (readMaybe)
import Prelude

-- | A t'AST.Pattern' with all the selections and interpolations resolved down to
-- t'SomeValue' and isolation marks.
newtype Pattern = Pattern (NonEmpty PatternElement)
    deriving newtype (NonEmpty Pattern -> Pattern
Pattern -> Pattern -> Pattern
(Pattern -> Pattern -> Pattern)
-> (NonEmpty Pattern -> Pattern)
-> (forall b. Integral b => b -> Pattern -> Pattern)
-> Semigroup Pattern
forall b. Integral b => b -> Pattern -> Pattern
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Pattern -> Pattern -> Pattern
<> :: Pattern -> Pattern -> Pattern
$csconcat :: NonEmpty Pattern -> Pattern
sconcat :: NonEmpty Pattern -> Pattern
$cstimes :: forall b. Integral b => b -> Pattern -> Pattern
stimes :: forall b. Integral b => b -> Pattern -> Pattern
Semigroup, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pattern -> ShowS
showsPrec :: Int -> Pattern -> ShowS
$cshow :: Pattern -> String
show :: Pattern -> String
$cshowList :: [Pattern] -> ShowS
showList :: [Pattern] -> ShowS
Show)

-- | A single piece of a t'Pattern'.
data PatternElement
    = -- | A value, ready to be formatted.
      Value SomeValue
    | -- | A sequence of values surrounded by isolation marks (FSI, PDI).
      Isolated Pattern
    deriving stock (Int -> PatternElement -> ShowS
[PatternElement] -> ShowS
PatternElement -> String
(Int -> PatternElement -> ShowS)
-> (PatternElement -> String)
-> ([PatternElement] -> ShowS)
-> Show PatternElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatternElement -> ShowS
showsPrec :: Int -> PatternElement -> ShowS
$cshow :: PatternElement -> String
show :: PatternElement -> String
$cshowList :: [PatternElement] -> ShowS
showList :: [PatternElement] -> ShowS
Show)

instance IsString Pattern where
    fromString :: String -> Pattern
fromString = NonEmpty PatternElement -> Pattern
Pattern (NonEmpty PatternElement -> Pattern)
-> (String -> NonEmpty PatternElement) -> String -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternElement -> NonEmpty PatternElement
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternElement -> NonEmpty PatternElement)
-> (String -> PatternElement) -> String -> NonEmpty PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PatternElement
forall a. IsString a => String -> a
fromString

instance IsString PatternElement where
    fromString :: String -> PatternElement
fromString = SomeValue -> PatternElement
Value (SomeValue -> PatternElement)
-> (String -> SomeValue) -> String -> PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SomeValue
forall a. IsString a => String -> a
fromString

instance Value Pattern where
    value :: Pattern -> SomeValue
value = CustomValue -> SomeValue
SomeValue (CustomValue -> SomeValue)
-> (Pattern -> CustomValue) -> Pattern -> SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CustomValue
forall v. Value v => v -> CustomValue
CustomValue

    format :: forall l. Locale l => NonEmpty l -> Pattern -> Either String Text
format NonEmpty l
locale (Pattern NonEmpty PatternElement
elements) =
        (PatternElement -> Either String Text)
-> [PatternElement] -> Either String Text
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mconcatMapM (NonEmpty l -> PatternElement -> Either String Text
forall l.
Locale l =>
NonEmpty l -> PatternElement -> Either String Text
forall v l.
(Value v, Locale l) =>
NonEmpty l -> v -> Either String Text
format NonEmpty l
locale) ([PatternElement] -> Either String Text)
-> [PatternElement] -> Either String Text
forall a b. (a -> b) -> a -> b
$ NonEmpty PatternElement -> [PatternElement]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty PatternElement
elements

instance Value PatternElement where
    value :: PatternElement -> SomeValue
value = CustomValue -> SomeValue
SomeValue (CustomValue -> SomeValue)
-> (PatternElement -> CustomValue) -> PatternElement -> SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternElement -> CustomValue
forall v. Value v => v -> CustomValue
CustomValue

    format :: forall l.
Locale l =>
NonEmpty l -> PatternElement -> Either String Text
format NonEmpty l
locale (Value SomeValue
v) = NonEmpty l -> SomeValue -> Either String Text
forall l. Locale l => NonEmpty l -> SomeValue -> Either String Text
forall v l.
(Value v, Locale l) =>
NonEmpty l -> v -> Either String Text
format NonEmpty l
locale SomeValue
v
    format NonEmpty l
locale (Isolated Pattern
pattern) = Text -> Text
isolate (Text -> Text) -> Either String Text -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty l -> Pattern -> Either String Text
forall l. Locale l => NonEmpty l -> Pattern -> Either String Text
forall v l.
(Value v, Locale l) =>
NonEmpty l -> v -> Either String Text
format NonEmpty l
locale Pattern
pattern

isolate :: Text -> Text
isolate :: Text -> Text
isolate = (Text
"\x2068" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x2069")

fromValue :: (Value v) => v -> Pattern
fromValue :: forall v. Value v => v -> Pattern
fromValue = NonEmpty PatternElement -> Pattern
Pattern (NonEmpty PatternElement -> Pattern)
-> (v -> NonEmpty PatternElement) -> v -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternElement -> NonEmpty PatternElement
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternElement -> NonEmpty PatternElement)
-> (v -> PatternElement) -> v -> NonEmpty PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeValue -> PatternElement
Value (SomeValue -> PatternElement)
-> (v -> SomeValue) -> v -> PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> SomeValue
forall v. Value v => v -> SomeValue
value

interpolates :: AST.Expression -> Bool
interpolates :: Expression -> Bool
interpolates (AST.Inline AST.MessageReference{}) = Bool
True
interpolates (AST.Inline AST.TermReference{}) = Bool
True
interpolates (AST.Inline AST.StringLiteralExpression{}) = Bool
True
interpolates (AST.Inline AST.VariableReference{}) = Bool
True
interpolates Expression
_ = Bool
False

attribute :: Identifier -> [AST.Attribute] -> Maybe AST.Pattern
attribute :: Identifier -> [Attribute] -> Maybe Pattern
attribute Identifier
name [Attribute]
attributes =
    [Pattern] -> Maybe Pattern
forall a. [a] -> Maybe a
listToMaybe [Pattern
pattern | AST.Attribute Identifier
name' Pattern
pattern <- [Attribute]
attributes, Identifier
name' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
name]

termArguments :: Maybe AST.CallArguments -> Either String (HashMap Identifier SomeValue)
termArguments :: Maybe CallArguments -> Either String (HashMap Identifier SomeValue)
termArguments Maybe CallArguments
Nothing = HashMap Identifier SomeValue
-> Either String (HashMap Identifier SomeValue)
forall a b. b -> Either a b
Right HashMap Identifier SomeValue
forall a. Monoid a => a
mempty
termArguments (Just (AST.CallArguments ([Either NamedArgument InlineExpression]
-> ([NamedArgument], [InlineExpression])
forall a b. [Either a b] -> ([a], [b])
partitionEithers -> ([NamedArgument]
named, [InlineExpression]
positional))))
    | [InlineExpression] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InlineExpression]
positional = HashMap Identifier SomeValue
-> Either String (HashMap Identifier SomeValue)
forall a b. b -> Either a b
Right (HashMap Identifier SomeValue
 -> Either String (HashMap Identifier SomeValue))
-> ([(Identifier, SomeValue)] -> HashMap Identifier SomeValue)
-> [(Identifier, SomeValue)]
-> Either String (HashMap Identifier SomeValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Identifier, SomeValue)] -> HashMap Identifier SomeValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Identifier, SomeValue)]
 -> Either String (HashMap Identifier SomeValue))
-> [(Identifier, SomeValue)]
-> Either String (HashMap Identifier SomeValue)
forall a b. (a -> b) -> a -> b
$ NamedArgument -> (Identifier, SomeValue)
namedArgument (NamedArgument -> (Identifier, SomeValue))
-> [NamedArgument] -> [(Identifier, SomeValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedArgument]
named
    | Bool
otherwise = String -> Either String (HashMap Identifier SomeValue)
forall a b. a -> Either a b
Left String
"Positional arguments are not allowed"

namedArgument :: AST.NamedArgument -> (AST.Identifier, SomeValue)
namedArgument :: NamedArgument -> (Identifier, SomeValue)
namedArgument (AST.NamedArgument Identifier
i Either StringLiteral NumberLiteral
l) = (Identifier
i, Either StringLiteral NumberLiteral -> SomeValue
literal Either StringLiteral NumberLiteral
l)

literal :: Either AST.StringLiteral AST.NumberLiteral -> SomeValue
literal :: Either StringLiteral NumberLiteral -> SomeValue
literal (Left StringLiteral
s) = Text -> SomeValue
StringValue StringLiteral
s.value
literal (Right NumberLiteral
n) = (Scientific -> NumberOptions -> SomeValue)
-> (Scientific, NumberOptions) -> SomeValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Scientific -> NumberOptions -> SomeValue
NumberValue ((Scientific, NumberOptions) -> SomeValue)
-> (Scientific, NumberOptions) -> SomeValue
forall a b. (a -> b) -> a -> b
$ NumberLiteral -> (Scientific, NumberOptions)
Number.fromLiteral NumberLiteral
n

variantKey :: AST.Variant -> SomeValue
variantKey :: Variant -> SomeValue
variantKey AST.Variant{key :: Variant -> VariantKey
key = AST.VariantKey (Left NumberLiteral
n)} = (Scientific -> NumberOptions -> SomeValue)
-> (Scientific, NumberOptions) -> SomeValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Scientific -> NumberOptions -> SomeValue
NumberValue ((Scientific, NumberOptions) -> SomeValue)
-> (Scientific, NumberOptions) -> SomeValue
forall a b. (a -> b) -> a -> b
$ NumberLiteral -> (Scientific, NumberOptions)
Number.fromLiteral NumberLiteral
n
variantKey AST.Variant{key :: Variant -> VariantKey
key = AST.VariantKey (Right (AST.Identifier Text
name))} = Text -> SomeValue
StringValue Text
name

-- | Whether a selector value exactly equals a variant key.
matchesExact :: SomeValue -> SomeValue -> Bool
matchesExact :: SomeValue -> SomeValue -> Bool
matchesExact (StringValue Text
a) (StringValue Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
matchesExact (NumberValue Scientific
a NumberOptions
_) (NumberValue Scientific
b NumberOptions
_) = Scientific
a Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
b
matchesExact SomeValue
_ SomeValue
_ = Bool
False

-- | Whether a numeric selector falls into the plural category named by a variant key
-- (e.g. a selector of @1@ against the key @one@).
matchesCategory :: (Locale l) => l -> SomeValue -> SomeValue -> Bool
matchesCategory :: forall l. Locale l => l -> SomeValue -> SomeValue -> Bool
matchesCategory l
locale SomeValue
selector SomeValue
key = case (SomeValue
selector, SomeValue
key) of
    (StringValue Text
name, NumberValue Scientific
n NumberOptions
options) -> Scientific -> NumberOptions -> Text -> Bool
counts Scientific
n NumberOptions
options Text
name
    (NumberValue Scientific
n NumberOptions
options, StringValue Text
name) -> Scientific -> NumberOptions -> Text -> Bool
counts Scientific
n NumberOptions
options Text
name
    (SomeValue, SomeValue)
_ -> Bool
False
  where
    counts :: Scientific -> NumberOptions -> Text -> Bool
counts Scientific
n NumberOptions
options 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)