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 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 (ToValue (..), Value)
import Language.Fluent.Value qualified as Value
import Prelude

-- | A t'AST.Pattern' with all the selections and interpolations resolved down to
-- t'Value' 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 Value
    | -- | 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

-- | Format a pattern for the locales, in order of preference.
format :: (Locale l) => NonEmpty l -> Pattern -> Either String Text
format locales (Pattern elements) = mconcatMapM element $ NonEmpty.toList elements
  where
    element (Value v) = Value.format locales v
    element (Isolated inner) = isolate <$> format locales inner

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

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

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 Value)
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, Value)
namedArgument (AST.NamedArgument i l) = (i, literal l)

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

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