{- HLINT ignore "Use zipWithM" -}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module Language.Fluent.Bundle where

import Control.Applicative ((<|>))
import Control.Monad (guard, when)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (StateT)
import Control.Monad.Trans.State.Strict qualified as StateT
import Data.Coerce (coerce)
import Data.Either (partitionEithers)
import Data.Either.Extra (maybeToEither)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.Kind (Type)
import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (listToMaybe)
import Data.Semigroup (sconcat)
import Data.Text (Text)
import Data.Text qualified as Text
import Language.Fluent.AST (Identifier (Identifier), Resource (Resource))
import Language.Fluent.AST qualified as AST
import Language.Fluent.Function (builtins)
import Language.Fluent.Locale (Locale)
import Language.Fluent.Locale qualified as Locale
import Language.Fluent.Number qualified as Number
import Language.Fluent.Pattern
    ( Pattern (..)
    , PatternElement (..)
    , attribute
    , namedArgument
    , termArguments
    , variantKey
    )
import Language.Fluent.Pattern qualified as Pattern
import Language.Fluent.Value (Value)
import Language.Fluent.Value qualified as Value
import Prelude

-- | A collection of Fluent resources and the configuration needed to
-- resolve and format messages for a locale.
data Bundle (locale :: Type) = Bundle
    { forall locale. Bundle locale -> NonEmpty locale
locales :: NonEmpty locale
    -- ^ The locale of the messages, followed by the fallback locales for number and date formatting.
    , forall locale. Bundle locale -> [Resource]
resources :: [Resource]
    -- ^ Message and term definitions, searched in order.
    , forall locale.
Bundle locale
-> HashMap
     Identifier
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
functions
        :: HashMap
            Identifier
            ( [Pattern]
              -> HashMap Identifier Value
              -> Either String Pattern
            )
    -- ^ Functions available to messages, shadowing the builtins of the same name.
    , forall locale. Bundle locale -> Bool
useIsolating :: Bool
    -- ^ Whether to use isolation marks (FSI, PDI) around interpolated values.
    }

-- | A change to a 'Bundle'.
data Override
    = -- | Whether to use isolation marks around placeables.
      UseIsolating Bool
    | -- | Add a function, shadowing the builtin of the same name.
      WithFunction Identifier ([Pattern] -> HashMap Identifier Value -> Either String Pattern)

-- | Apply an 'Override' to a 'Bundle'.
override :: Override -> Bundle locale -> Bundle locale
override :: forall locale. Override -> Bundle locale -> Bundle locale
override (UseIsolating Bool
useIsolating) Bundle locale
bundle = Bundle locale
bundle{useIsolating}
override (WithFunction Identifier
name [Pattern] -> HashMap Identifier Value -> Either String Pattern
f) Bundle locale
bundle = Bundle locale
bundle{functions = HashMap.insert name f bundle.functions}

-- | The codes of the locales of a bundle.
localeCodes :: (Locale locale) => Bundle locale -> NonEmpty Text
localeCodes :: forall locale. Locale locale => Bundle locale -> NonEmpty Text
localeCodes Bundle{NonEmpty locale
locales :: forall locale. Bundle locale -> NonEmpty locale
locales :: NonEmpty locale
locales} = locale -> Text
forall l. Locale l => l -> Text
Locale.toCode (locale -> Text) -> NonEmpty locale -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty locale
locales

-- | Only the names of the @functions@ are compared, since their implementations
-- cannot be compared for equality.
instance (Locale locale) => Eq (Bundle locale) where
    Bundle locale
b1 == :: Bundle locale -> Bundle locale -> Bool
== Bundle locale
b2 =
        Bundle locale -> NonEmpty Text
forall locale. Locale locale => Bundle locale -> NonEmpty Text
localeCodes Bundle locale
b1 NonEmpty Text -> NonEmpty Text -> Bool
forall a. Eq a => a -> a -> Bool
== Bundle locale -> NonEmpty Text
forall locale. Locale locale => Bundle locale -> NonEmpty Text
localeCodes Bundle locale
b2
            Bool -> Bool -> Bool
&& Bundle locale
b1.resources [Resource] -> [Resource] -> Bool
forall a. Eq a => a -> a -> Bool
== Bundle locale
b2.resources
            Bool -> Bool -> Bool
&& HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> HashSet Identifier
forall k a. HashMap k a -> HashSet k
HashMap.keysSet Bundle locale
b1.functions HashSet Identifier -> HashSet Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> HashSet Identifier
forall k a. HashMap k a -> HashSet k
HashMap.keysSet Bundle locale
b2.functions
            Bool -> Bool -> Bool
&& Bundle locale
b1.useIsolating Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bundle locale
b2.useIsolating

instance (Locale locale) => Show (Bundle locale) where
    show :: Bundle locale -> String
show Bundle locale
bundle =
        Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
            Text
"Bundle{"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate
                    Text
","
                    [ Text
locales
                    , Text
resources
                    , Text
functions
                    , Text
useIsolating
                    ]
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
      where
        locales :: Text
locales =
            Text
"locales=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
Text.show (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Text -> [Text])
-> (Bundle locale -> NonEmpty Text) -> Bundle locale -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle locale -> NonEmpty Text
forall locale. Locale locale => Bundle locale -> NonEmpty Text
localeCodes (Bundle locale -> [Text]) -> Bundle locale -> [Text]
forall a b. (a -> b) -> a -> b
$ Bundle locale
bundle)
        resources :: Text
resources = Text
"resources=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Resource] -> Text
forall a. Show a => a -> Text
Text.show Bundle locale
bundle.resources
        functions :: Text
functions = Text
"functions=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Identifier] -> Text
forall a. Show a => a -> Text
Text.show (HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> [Identifier]
forall k v. HashMap k v -> [k]
HashMap.keys Bundle locale
bundle.functions)
        useIsolating :: Text
useIsolating = Text
"useIsolating=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall a. Show a => a -> Text
Text.show Bundle locale
bundle.useIsolating

-- | A bundle of 'Resource's for the given 'Locale's, with the default configuration.
bundle :: NonEmpty locale -> [Resource] -> Bundle locale
bundle :: forall locale. NonEmpty locale -> [Resource] -> Bundle locale
bundle NonEmpty locale
locales [Resource]
resources = Bundle{NonEmpty locale
locales :: NonEmpty locale
locales :: NonEmpty locale
locales, [Resource]
resources :: [Resource]
resources :: [Resource]
resources, functions :: HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
functions = HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall a. Monoid a => a
mempty, useIsolating :: Bool
useIsolating = Bool
True}

-- | The first message of a 'Bundle' with the identifier.
message :: Identifier -> Bundle locale -> Maybe AST.Message
message :: forall locale. Identifier -> Bundle locale -> Maybe Message
message Identifier
id Bundle{[Resource]
resources :: forall locale. Bundle locale -> [Resource]
resources :: [Resource]
resources} = [Message] -> Maybe Message
forall a. [a] -> Maybe a
listToMaybe do
    Resource{[Entry]
entries :: [Entry]
entries :: Resource -> [Entry]
entries} <- [Resource]
resources
    AST.MessageEntry Message
found <- [Entry]
entries
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Message
found.id Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
id
    pure Message
found

-- | The first term of a 'Bundle' with the identifier.
term :: Identifier -> Bundle locale -> Maybe AST.Term
term :: forall locale. Identifier -> Bundle locale -> Maybe Term
term Identifier
name Bundle{[Resource]
resources :: forall locale. Bundle locale -> [Resource]
resources :: [Resource]
resources} = [Term] -> Maybe Term
forall a. [a] -> Maybe a
listToMaybe do
    Resource{[Entry]
entries :: Resource -> [Entry]
entries :: [Entry]
entries} <- [Resource]
resources
    AST.TermEntry Term
found <- [Entry]
entries
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Term
found.id Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
name
    pure Term
found

-- | Resolve all the selections and interpolations of an AST 'AST.Pattern' to a simple 'Pattern'.
pattern
    :: (Locale locale)
    => Bundle locale
    -> HashMap Identifier Value
    -> AST.Pattern
    -> Either String Pattern
pattern :: forall locale.
Locale locale =>
Bundle locale
-> HashMap Identifier Value -> Pattern -> Either String Pattern
pattern bundle :: Bundle locale
bundle@Bundle{locales :: forall locale. Bundle locale -> NonEmpty locale
locales = locale
locale :| [locale]
_, Bool
[Resource]
HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
resources :: forall locale. Bundle locale -> [Resource]
functions :: forall locale.
Bundle locale
-> HashMap
     Identifier
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
useIsolating :: forall locale. Bundle locale -> Bool
resources :: [Resource]
functions :: HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
useIsolating :: Bool
..} = ((StateT Int (Either String) Pattern
 -> Int -> Either String Pattern)
-> Int
-> StateT Int (Either String) Pattern
-> Either String Pattern
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Int (Either String) Pattern -> Int -> Either String Pattern
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
StateT.evalStateT Int
0 (StateT Int (Either String) Pattern -> Either String Pattern)
-> (Pattern -> StateT Int (Either String) Pattern)
-> Pattern
-> Either String Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Pattern -> StateT Int (Either String) Pattern)
 -> Pattern -> Either String Pattern)
-> (HashMap Identifier Value
    -> Pattern -> StateT Int (Either String) Pattern)
-> HashMap Identifier Value
-> Pattern
-> Either String Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet Identifier
-> HashMap Identifier Value
-> Pattern
-> StateT Int (Either String) Pattern
resolve HashSet Identifier
forall a. Monoid a => a
mempty
  where
    resolve
        :: HashSet Identifier
        -> HashMap Identifier Value
        -> AST.Pattern
        -> StateT Int (Either String) Pattern
    resolve :: HashSet Identifier
-> HashMap Identifier Value
-> Pattern
-> StateT Int (Either String) Pattern
resolve HashSet Identifier
followed HashMap Identifier Value
arguments (AST.Pattern NonEmpty PatternElement
elements) =
        NonEmpty Pattern -> Pattern
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Pattern -> Pattern)
-> StateT Int (Either String) (NonEmpty Pattern)
-> StateT Int (Either String) Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (StateT Int (Either String) Pattern)
-> StateT Int (Either String) (NonEmpty Pattern)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => NonEmpty (m a) -> m (NonEmpty a)
sequence ((Bool -> PatternElement -> StateT Int (Either String) Pattern)
-> NonEmpty Bool
-> NonEmpty PatternElement
-> NonEmpty (StateT Int (Either String) Pattern)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NonEmpty.zipWith Bool -> PatternElement -> StateT Int (Either String) Pattern
element (Bool
True Bool -> [Bool] -> NonEmpty Bool
forall a. a -> [a] -> NonEmpty a
:| Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) NonEmpty PatternElement
elements)
      where
        element :: Bool -> AST.PatternElement -> StateT Int (Either String) Pattern
        element :: Bool -> PatternElement -> StateT Int (Either String) Pattern
element Bool
_ (AST.InlineText Text
t) = Pattern -> StateT Int (Either String) Pattern
forall a. a -> StateT Int (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern -> StateT Int (Either String) Pattern)
-> Pattern -> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern
forall v. ToValue v => v -> Pattern
Pattern.fromValue Text
t
        element Bool
_ (AST.BlockText Text
t) = Pattern -> StateT Int (Either String) Pattern
forall a. a -> StateT Int (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern -> StateT Int (Either String) Pattern)
-> Pattern -> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern
forall v. ToValue v => v -> Pattern
Pattern.fromValue Text
t
        element Bool
first (AST.Placeable Placeable
placeable) = do
            Int
expanded <- StateT Int (Either String) Int
forall (m :: * -> *) s. Monad m => StateT s m s
StateT.get
            Bool
-> StateT Int (Either String) () -> StateT Int (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
expanded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100) (StateT Int (Either String) () -> StateT Int (Either String) ())
-> (Either String () -> StateT Int (Either String) ())
-> Either String ()
-> StateT Int (Either String) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String () -> StateT Int (Either String) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String () -> StateT Int (Either String) ())
-> Either String () -> StateT Int (Either String) ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left String
"Too many placeables expanded"
            Int -> StateT Int (Either String) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateT.put (Int -> StateT Int (Either String) ())
-> Int -> StateT Int (Either String) ()
forall a b. (a -> b) -> a -> b
$ Int
expanded Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            Pattern -> Pattern
beginsLine (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
isolated
                (Pattern -> Pattern)
-> StateT Int (Either String) Pattern
-> StateT Int (Either String) Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet Identifier
-> HashMap Identifier Value
-> Expression
-> StateT Int (Either String) Pattern
expression HashSet Identifier
followed HashMap Identifier Value
arguments (Placeable -> Expression
AST.placeableExpression Placeable
placeable)
          where
            beginsLine :: Pattern -> Pattern
beginsLine
                | AST.BlockPlaceable{} <- Placeable
placeable, Bool -> Bool
not Bool
first = (Pattern
"\n" Pattern -> Pattern -> Pattern
forall a. Semigroup a => a -> a -> a
<>)
                | Bool
otherwise = Pattern -> Pattern
forall a. a -> a
id

        isolated :: Pattern -> Pattern
isolated
            | NonEmpty PatternElement -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty PatternElement
elements Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1, Bool
useIsolating = NonEmpty PatternElement -> Pattern
Pattern (NonEmpty PatternElement -> Pattern)
-> (Pattern -> NonEmpty PatternElement) -> Pattern -> 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)
-> (Pattern -> PatternElement)
-> Pattern
-> NonEmpty PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> PatternElement
Isolated
            | Bool
otherwise = Pattern -> Pattern
forall a. a -> a
id

    expression
        :: HashSet Identifier
        -> HashMap Identifier Value
        -> AST.Expression
        -> StateT Int (Either String) Pattern
    expression :: HashSet Identifier
-> HashMap Identifier Value
-> Expression
-> StateT Int (Either String) Pattern
expression HashSet Identifier
followed HashMap Identifier Value
arguments (AST.Inline InlineExpression
inline) =
        HashSet Identifier
-> HashMap Identifier Value
-> InlineExpression
-> StateT Int (Either String) Pattern
inlineExpression HashSet Identifier
followed HashMap Identifier Value
arguments InlineExpression
inline
    expression HashSet Identifier
followed HashMap Identifier Value
arguments (AST.Select (AST.SelectExpression InlineExpression
selector VariantList
variants')) = do
        let AST.VariantList NonEmpty Variant
variants = VariantList
variants'
        Maybe Variant
picked <- case InlineExpression
selector of
            AST.VariableReference Identifier
name | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Identifier
name Identifier -> HashMap Identifier Value -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMap.member` HashMap Identifier Value
arguments -> Maybe Variant -> StateT Int (Either String) (Maybe Variant)
forall a. a -> StateT Int (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Variant
forall a. Maybe a
Nothing
            InlineExpression
_ -> Either String (Maybe Variant)
-> StateT Int (Either String) (Maybe Variant)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (Maybe Variant)
 -> StateT Int (Either String) (Maybe Variant))
-> (Pattern -> Either String (Maybe Variant))
-> Pattern
-> StateT Int (Either String) (Maybe Variant)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Variant -> Pattern -> Either String (Maybe Variant)
matching NonEmpty Variant
variants (Pattern -> StateT Int (Either String) (Maybe Variant))
-> StateT Int (Either String) Pattern
-> StateT Int (Either String) (Maybe Variant)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HashSet Identifier
-> HashMap Identifier Value
-> InlineExpression
-> StateT Int (Either String) Pattern
inlineExpression HashSet Identifier
followed HashMap Identifier Value
arguments InlineExpression
selector
        AST.Variant{value :: Variant -> Pattern
value = Pattern
picked'} <-
            Either String Variant -> StateT Int (Either String) Variant
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String Variant -> StateT Int (Either String) Variant)
-> (Maybe Variant -> Either String Variant)
-> Maybe Variant
-> StateT Int (Either String) Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Variant -> Either String Variant
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Select expression has no default variant" (Maybe Variant -> StateT Int (Either String) Variant)
-> Maybe Variant -> StateT Int (Either String) Variant
forall a b. (a -> b) -> a -> b
$
                Maybe Variant
picked Maybe Variant -> Maybe Variant -> Maybe Variant
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Variant -> Bool) -> NonEmpty Variant -> Maybe Variant
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find Variant -> Bool
AST.isDefault NonEmpty Variant
variants
        HashSet Identifier
-> HashMap Identifier Value
-> Pattern
-> StateT Int (Either String) Pattern
resolve HashSet Identifier
followed HashMap Identifier Value
arguments Pattern
picked'

    matching :: NonEmpty Variant -> Pattern -> Either String (Maybe Variant)
matching NonEmpty Variant
variants (Pattern (Value Value
selected :| [])) =
        Maybe Variant -> Either String (Maybe Variant)
forall a b. b -> Either a b
Right (Maybe Variant -> Either String (Maybe Variant))
-> Maybe Variant -> Either String (Maybe Variant)
forall a b. (a -> b) -> a -> b
$
            (Variant -> Bool) -> NonEmpty Variant -> Maybe Variant
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Value -> Value -> Bool
Value.matchesExact Value
selected (Value -> Bool) -> (Variant -> Value) -> Variant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Value
variantKey) NonEmpty Variant
variants
                Maybe Variant -> Maybe Variant -> Maybe Variant
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Variant -> Bool) -> NonEmpty Variant -> Maybe Variant
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (locale -> Value -> Value -> Bool
forall l. Locale l => l -> Value -> Value -> Bool
Value.matchesCategory locale
locale Value
selected (Value -> Bool) -> (Variant -> Value) -> Variant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> Value
variantKey) NonEmpty Variant
variants
    matching NonEmpty Variant
_ Pattern
_ = String -> Either String (Maybe Variant)
forall a b. a -> Either a b
Left String
"Selector is not a number or identifier"

    inlineExpression
        :: HashSet Identifier
        -> HashMap Identifier Value
        -> AST.InlineExpression
        -> StateT Int (Either String) Pattern
    inlineExpression :: HashSet Identifier
-> HashMap Identifier Value
-> InlineExpression
-> StateT Int (Either String) Pattern
inlineExpression HashSet Identifier
_ HashMap Identifier Value
_ (AST.StringLiteralExpression StringLiteral
s) = Pattern -> StateT Int (Either String) Pattern
forall a. a -> StateT Int (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern -> StateT Int (Either String) Pattern)
-> (Text -> Pattern) -> Text -> StateT Int (Either String) Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pattern
forall v. ToValue v => v -> Pattern
Pattern.fromValue (Text -> StateT Int (Either String) Pattern)
-> Text -> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$ StringLiteral
s.value
    inlineExpression HashSet Identifier
_ HashMap Identifier Value
_ (AST.NumberLiteralExpression NumberLiteral
n) =
        Pattern -> StateT Int (Either String) Pattern
forall a. a -> StateT Int (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern -> StateT Int (Either String) Pattern)
-> ((Scientific, NumberOptions) -> Pattern)
-> (Scientific, NumberOptions)
-> StateT Int (Either String) Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Pattern
forall v. ToValue v => v -> Pattern
Pattern.fromValue (Value -> Pattern)
-> ((Scientific, NumberOptions) -> Value)
-> (Scientific, NumberOptions)
-> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> NumberOptions -> Value)
-> (Scientific, NumberOptions) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Scientific -> NumberOptions -> Value
Value.Number ((Scientific, NumberOptions) -> StateT Int (Either String) Pattern)
-> (Scientific, NumberOptions)
-> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$ NumberLiteral -> (Scientific, NumberOptions)
Number.fromLiteral NumberLiteral
n
    inlineExpression HashSet Identifier
followed HashMap Identifier Value
arguments (AST.PlaceableExpression Expression
expr) =
        HashSet Identifier
-> HashMap Identifier Value
-> Expression
-> StateT Int (Either String) Pattern
expression HashSet Identifier
followed HashMap Identifier Value
arguments Expression
expr
    inlineExpression HashSet Identifier
_ HashMap Identifier Value
arguments (AST.VariableReference Identifier
id) =
        Either String Pattern -> StateT Int (Either String) Pattern
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
            (Either String Pattern -> StateT Int (Either String) Pattern)
-> (Maybe Value -> Either String Pattern)
-> Maybe Value
-> StateT Int (Either String) Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Pattern) -> Either String Value -> Either String Pattern
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Pattern
forall v. ToValue v => v -> Pattern
Pattern.fromValue
            (Either String Value -> Either String Pattern)
-> (Maybe Value -> Either String Value)
-> Maybe Value
-> Either String Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Value -> Either String Value
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Variable not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
id)
            (Maybe Value -> StateT Int (Either String) Pattern)
-> Maybe Value -> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$ Identifier -> HashMap Identifier Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
id HashMap Identifier Value
arguments
    inlineExpression HashSet Identifier
followed HashMap Identifier Value
arguments (AST.FunctionReference Identifier
id CallArguments
called) = do
        let AST.CallArguments [Either NamedArgument InlineExpression]
args = CallArguments
called
        [Pattern] -> HashMap Identifier Value -> Either String Pattern
f <-
            Either
  String
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> StateT
     Int
     (Either String)
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either
   String
   ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
 -> StateT
      Int
      (Either String)
      ([Pattern] -> HashMap Identifier Value -> Either String Pattern))
-> (Maybe
      ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
    -> Either
         String
         ([Pattern] -> HashMap Identifier Value -> Either String Pattern))
-> Maybe
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> StateT
     Int
     (Either String)
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Maybe
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> Either
     String
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Function not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
id) (Maybe
   ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
 -> StateT
      Int
      (Either String)
      ([Pattern] -> HashMap Identifier Value -> Either String Pattern))
-> Maybe
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> StateT
     Int
     (Either String)
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall a b. (a -> b) -> a -> b
$
                Identifier
-> HashMap
     Identifier
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> Maybe
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
id Bundle locale
bundle.functions Maybe
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> Maybe
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> Maybe
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Identifier
-> HashMap
     Identifier
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
-> Maybe
     ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
id HashMap
  Identifier
  ([Pattern] -> HashMap Identifier Value -> Either String Pattern)
builtins
        let ([NamedArgument]
named, [InlineExpression]
positional) = [Either NamedArgument InlineExpression]
-> ([NamedArgument], [InlineExpression])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either NamedArgument InlineExpression]
args
        [Pattern]
positional' <- (InlineExpression -> StateT Int (Either String) Pattern)
-> [InlineExpression] -> StateT Int (Either String) [Pattern]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (HashSet Identifier
-> HashMap Identifier Value
-> InlineExpression
-> StateT Int (Either String) Pattern
inlineExpression HashSet Identifier
followed HashMap Identifier Value
arguments) [InlineExpression]
positional
        Either String Pattern -> StateT Int (Either String) Pattern
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String Pattern -> StateT Int (Either String) Pattern)
-> ([(Identifier, Value)] -> Either String Pattern)
-> [(Identifier, Value)]
-> StateT Int (Either String) Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> HashMap Identifier Value -> Either String Pattern
f [Pattern]
positional' (HashMap Identifier Value -> Either String Pattern)
-> ([(Identifier, Value)] -> HashMap Identifier Value)
-> [(Identifier, Value)]
-> Either String Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Identifier, Value)] -> HashMap Identifier Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Identifier, Value)] -> StateT Int (Either String) Pattern)
-> [(Identifier, Value)] -> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$ NamedArgument -> (Identifier, Value)
namedArgument (NamedArgument -> (Identifier, Value))
-> [NamedArgument] -> [(Identifier, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedArgument]
named
    inlineExpression HashSet Identifier
followed HashMap Identifier Value
arguments (AST.MessageReference Identifier
id Maybe AttributeAccessor
accessor) = do
        Message
found <-
            Either String Message -> StateT Int (Either String) Message
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String Message -> StateT Int (Either String) Message)
-> (Maybe Message -> Either String Message)
-> Maybe Message
-> StateT Int (Either String) Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Message -> Either String Message
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Message not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Identifier -> Text
forall a b. Coercible a b => a -> b
coerce Identifier
id)) (Maybe Message -> StateT Int (Either String) Message)
-> Maybe Message -> StateT Int (Either String) Message
forall a b. (a -> b) -> a -> b
$
                Identifier -> Bundle locale -> Maybe Message
forall locale. Identifier -> Bundle locale -> Maybe Message
message Identifier
id Bundle locale
bundle
        Pattern
found' <- Either String Pattern -> StateT Int (Either String) Pattern
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift case Maybe AttributeAccessor
accessor of
            Maybe AttributeAccessor
Nothing -> String -> Maybe Pattern -> Either String Pattern
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Message has no value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
id) Message
found.value
            Just (AST.AttributeAccessor Identifier
it) -> Identifier -> Identifier -> [Attribute] -> Either String Pattern
attributeOf Identifier
id Identifier
it Message
found.attributes
        HashSet Identifier
-> HashMap Identifier Value
-> Identifier
-> Pattern
-> StateT Int (Either String) Pattern
follow HashSet Identifier
followed HashMap Identifier Value
arguments (Identifier -> Maybe AttributeAccessor -> Identifier
reference (Identifier -> Identifier
forall a b. Coercible a b => a -> b
coerce Identifier
id) Maybe AttributeAccessor
accessor) Pattern
found'
    inlineExpression HashSet Identifier
followed HashMap Identifier Value
_ (AST.TermReference Identifier
id Maybe AttributeAccessor
accessor Maybe CallArguments
args) = do
        Term
found <- Either String Term -> StateT Int (Either String) Term
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String Term -> StateT Int (Either String) Term)
-> (Maybe Term -> Either String Term)
-> Maybe Term
-> StateT Int (Either String) Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Term -> Either String Term
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Term not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
id) (Maybe Term -> StateT Int (Either String) Term)
-> Maybe Term -> StateT Int (Either String) Term
forall a b. (a -> b) -> a -> b
$ Identifier -> Bundle locale -> Maybe Term
forall locale. Identifier -> Bundle locale -> Maybe Term
term Identifier
id Bundle locale
bundle
        Pattern
found' <-
            Either String Pattern -> StateT Int (Either String) Pattern
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String Pattern -> StateT Int (Either String) Pattern)
-> Either String Pattern -> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$
                Either String Pattern
-> (AttributeAccessor -> Either String Pattern)
-> Maybe AttributeAccessor
-> Either String Pattern
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    (Pattern -> Either String Pattern
forall a b. b -> Either a b
Right Term
found.value)
                    (\(AST.AttributeAccessor Identifier
it) -> Identifier -> Identifier -> [Attribute] -> Either String Pattern
attributeOf (Identifier -> Identifier
withDash Identifier
id) Identifier
it Term
found.attributes)
                    Maybe AttributeAccessor
accessor
        HashMap Identifier Value
arguments' <- Either String (HashMap Identifier Value)
-> StateT Int (Either String) (HashMap Identifier Value)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (HashMap Identifier Value)
 -> StateT Int (Either String) (HashMap Identifier Value))
-> Either String (HashMap Identifier Value)
-> StateT Int (Either String) (HashMap Identifier Value)
forall a b. (a -> b) -> a -> b
$ Maybe CallArguments -> Either String (HashMap Identifier Value)
termArguments Maybe CallArguments
args
        HashSet Identifier
-> HashMap Identifier Value
-> Identifier
-> Pattern
-> StateT Int (Either String) Pattern
follow HashSet Identifier
followed HashMap Identifier Value
arguments' (Identifier -> Maybe AttributeAccessor -> Identifier
reference (Identifier -> Identifier
withDash Identifier
id) Maybe AttributeAccessor
accessor) Pattern
found'

    attributeOf
        :: Identifier
        -> Identifier
        -> [AST.Attribute]
        -> Either String AST.Pattern
    attributeOf :: Identifier -> Identifier -> [Attribute] -> Either String Pattern
attributeOf Identifier
owner Identifier
name [Attribute]
attributes =
        String -> Maybe Pattern -> Either String Pattern
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Attribute not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Identifier, Identifier) -> String
forall a. Show a => a -> String
show (Identifier
owner, Identifier
name)) (Maybe Pattern -> Either String Pattern)
-> Maybe Pattern -> Either String Pattern
forall a b. (a -> b) -> a -> b
$
            Identifier -> [Attribute] -> Maybe Pattern
attribute Identifier
name [Attribute]
attributes

    withDash :: Identifier -> Identifier
    withDash :: Identifier -> Identifier
withDash (Identifier Text
i) = Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i

    reference :: Identifier -> Maybe AST.AttributeAccessor -> Identifier
    reference :: Identifier -> Maybe AttributeAccessor -> Identifier
reference (Identifier Text
name) (Just (AST.AttributeAccessor (Identifier Text
it))) =
        Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
it
    reference Identifier
name Maybe AttributeAccessor
_ = Identifier
name

    follow
        :: HashSet Identifier
        -> HashMap Identifier Value
        -> Identifier
        -> AST.Pattern
        -> StateT Int (Either String) Pattern
    follow :: HashSet Identifier
-> HashMap Identifier Value
-> Identifier
-> Pattern
-> StateT Int (Either String) Pattern
follow HashSet Identifier
followed HashMap Identifier Value
arguments Identifier
name Pattern
found
        | Identifier
name Identifier -> HashSet Identifier -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Identifier
followed = Either String Pattern -> StateT Int (Either String) Pattern
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String Pattern -> StateT Int (Either String) Pattern)
-> (String -> Either String Pattern)
-> String
-> StateT Int (Either String) Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Pattern
forall a b. a -> Either a b
Left (String -> StateT Int (Either String) Pattern)
-> String -> StateT Int (Either String) Pattern
forall a b. (a -> b) -> a -> b
$ String
"Cyclic reference: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
name
        | Bool
otherwise = HashSet Identifier
-> HashMap Identifier Value
-> Pattern
-> StateT Int (Either String) Pattern
resolve (Identifier -> HashSet Identifier -> HashSet Identifier
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Identifier
name HashSet Identifier
followed) HashMap Identifier Value
arguments Pattern
found