Pattern.hs

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 (Semigroup, 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 (Show)

instance IsString Pattern where
    fromString = Pattern . pure . fromString

instance IsString PatternElement where
    fromString = Value . fromString

instance Value Pattern where
    value = SomeValue . CustomValue

    format locale (Pattern elements) =
        mconcatMapM (format locale) $ NonEmpty.toList elements

instance Value PatternElement where
    value = SomeValue . CustomValue

    format locale (Value v) = format locale v
    format locale (Isolated pattern) = isolate <$> format locale pattern

isolate :: Text -> Text
isolate = ("\x2068" <>) . (<> "\x2069")

fromValue :: (Value v) => v -> Pattern
fromValue = Pattern . pure . Value . value

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

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

termArguments :: Maybe AST.CallArguments -> Either String (HashMap Identifier SomeValue)
termArguments Nothing = Right mempty
termArguments (Just (AST.CallArguments (partitionEithers -> (named, positional))))
    | null positional = Right . HashMap.fromList $ namedArgument <$> named
    | otherwise = Left "Positional arguments are not allowed"

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

literal :: Either AST.StringLiteral AST.NumberLiteral -> SomeValue
literal (Left s) = StringValue s.value
literal (Right n) = uncurry NumberValue $ Number.fromLiteral n

variantKey :: AST.Variant -> SomeValue
variantKey AST.Variant{key = AST.VariantKey (Left n)} = uncurry NumberValue $ Number.fromLiteral n
variantKey AST.Variant{key = AST.VariantKey (Right (AST.Identifier name))} = StringValue name

-- | Whether a selector value exactly equals a variant key.
matchesExact :: SomeValue -> SomeValue -> Bool
matchesExact (StringValue a) (StringValue b) = a == b
matchesExact (NumberValue a _) (NumberValue b _) = a == b
matchesExact _ _ = 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 locale selector key = case (selector, key) of
    (StringValue name, NumberValue n options) -> counts n options name
    (NumberValue n options, StringValue name) -> counts n options name
    _ -> False
  where
    counts n options name =
        Just (pluralCategory locale n options) == readMaybe (Text.unpack name)