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

module Language.Fluent.Bundle where

import Control.Applicative ((<|>))
import Control.Monad (guard)
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
    , interpolates
    , matchesCategory
    , matchesExact
    , namedArgument
    , termArguments
    , variantKey
    )
import Language.Fluent.Pattern qualified as Pattern
import Language.Fluent.Value (SomeValue (..))
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 SomeValue -> Either String Pattern)
functions
        :: HashMap
            Identifier
            ( [Pattern]
              -> HashMap Identifier SomeValue
              -> 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.
    }

data Override
    = UseIsolating Bool
    | WithFunction Identifier ([Pattern] -> HashMap Identifier SomeValue -> Either String Pattern)

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 SomeValue -> Either String Pattern
f) Bundle locale
bundle = Bundle locale
bundle{functions = HashMap.insert name f bundle.functions}

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 SomeValue -> 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 SomeValue -> 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 SomeValue -> 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

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 SomeValue -> Either String Pattern)
functions = HashMap
  Identifier
  ([Pattern]
   -> HashMap Identifier SomeValue -> Either String Pattern)
forall a. Monoid a => a
mempty, useIsolating :: Bool
useIsolating = Bool
True}

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

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

pattern
    :: (Locale locale)
    => Bundle locale
    -> HashMap Identifier SomeValue
    -> AST.Pattern
    -> Either String Pattern
pattern :: forall locale.
Locale locale =>
Bundle locale
-> HashMap Identifier SomeValue -> 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 SomeValue -> Either String Pattern)
resources :: forall locale. Bundle locale -> [Resource]
functions :: forall locale.
Bundle locale
-> HashMap
     Identifier
     ([Pattern]
      -> HashMap Identifier SomeValue -> Either String Pattern)
useIsolating :: forall locale. Bundle locale -> Bool
resources :: [Resource]
functions :: HashMap
  Identifier
  ([Pattern]
   -> HashMap Identifier SomeValue -> Either String Pattern)
useIsolating :: Bool
..} = HashSet Identifier
-> HashMap Identifier SomeValue -> Pattern -> Either String Pattern
resolve HashSet Identifier
forall a. Monoid a => a
mempty
  where
    resolve
        :: HashSet Identifier
        -> HashMap Identifier SomeValue
        -> AST.Pattern
        -> Either String Pattern
    resolve :: HashSet Identifier
-> HashMap Identifier SomeValue -> Pattern -> Either String Pattern
resolve HashSet Identifier
followed HashMap Identifier SomeValue
arguments (AST.Pattern NonEmpty PatternElement
elements) =
        NonEmpty Pattern -> Pattern
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Pattern -> Pattern)
-> Either String (NonEmpty Pattern) -> Either String Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Either String Pattern)
-> 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 -> Either String Pattern)
-> NonEmpty Bool
-> NonEmpty PatternElement
-> NonEmpty (Either String Pattern)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NonEmpty.zipWith Bool -> PatternElement -> 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 -> Either String Pattern
        element :: Bool -> PatternElement -> Either String Pattern
element Bool
_ (AST.InlineText Text
t) = Pattern -> Either String Pattern
forall a b. b -> Either a b
Right (Pattern -> Either String Pattern)
-> Pattern -> Either String Pattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern
forall v. Value v => v -> Pattern
Pattern.fromValue Text
t
        element Bool
_ (AST.BlockText Text
t) = Pattern -> Either String Pattern
forall a b. b -> Either a b
Right (Pattern -> Either String Pattern)
-> Pattern -> Either String Pattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern
forall v. Value v => v -> Pattern
Pattern.fromValue Text
t
        element Bool
first (AST.Placeable Placeable
placeable) =
            Pattern -> Pattern
beginsLine (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
isolated (Pattern -> Pattern)
-> Either String Pattern -> Either String Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet Identifier
-> HashMap Identifier SomeValue
-> Expression
-> Either String Pattern
expression HashSet Identifier
followed HashMap Identifier SomeValue
arguments Expression
expr
          where
            expr :: Expression
expr = Placeable -> Expression
AST.placeableExpression Placeable
placeable
            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
                , Expression -> Bool
interpolates Expression
expr =
                    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
            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

    expression
        :: HashSet Identifier
        -> HashMap Identifier SomeValue
        -> AST.Expression
        -> Either String Pattern
    expression :: HashSet Identifier
-> HashMap Identifier SomeValue
-> Expression
-> Either String Pattern
expression HashSet Identifier
followed HashMap Identifier SomeValue
arguments (AST.Inline InlineExpression
inline) =
        HashSet Identifier
-> HashMap Identifier SomeValue
-> InlineExpression
-> Either String Pattern
inlineExpression HashSet Identifier
followed HashMap Identifier SomeValue
arguments InlineExpression
inline
    expression HashSet Identifier
followed HashMap Identifier SomeValue
arguments (AST.Select (AST.SelectExpression InlineExpression
selector VariantList
variants')) = do
        let AST.VariantList NonEmpty Variant
variants = VariantList
variants'
        Maybe Variant
picked <- case HashSet Identifier
-> HashMap Identifier SomeValue
-> InlineExpression
-> Either String Pattern
inlineExpression HashSet Identifier
followed HashMap Identifier SomeValue
arguments InlineExpression
selector of
            Left{} -> Maybe Variant -> Either String (Maybe Variant)
forall a b. b -> Either a b
Right Maybe Variant
forall a. Maybe a
Nothing
            Right (Pattern (Value SomeValue
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 (SomeValue -> SomeValue -> Bool
matchesExact SomeValue
selected (SomeValue -> Bool) -> (Variant -> SomeValue) -> Variant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> SomeValue
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 -> SomeValue -> SomeValue -> Bool
forall l. Locale l => l -> SomeValue -> SomeValue -> Bool
matchesCategory locale
locale SomeValue
selected (SomeValue -> Bool) -> (Variant -> SomeValue) -> Variant -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variant -> SomeValue
variantKey) NonEmpty Variant
variants
            Right{} -> String -> Either String (Maybe Variant)
forall a b. a -> Either a b
Left String
"Selector is not a number or identifier"
        AST.Variant{value :: Variant -> Pattern
value = Pattern
picked'} <-
            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 -> Either String Variant)
-> Maybe Variant -> 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 SomeValue -> Pattern -> Either String Pattern
resolve HashSet Identifier
followed HashMap Identifier SomeValue
arguments Pattern
picked'

    inlineExpression
        :: HashSet Identifier
        -> HashMap Identifier SomeValue
        -> AST.InlineExpression
        -> Either String Pattern
    inlineExpression :: HashSet Identifier
-> HashMap Identifier SomeValue
-> InlineExpression
-> Either String Pattern
inlineExpression HashSet Identifier
_ HashMap Identifier SomeValue
_ (AST.StringLiteralExpression StringLiteral
s) = Pattern -> Either String Pattern
forall a b. b -> Either a b
Right (Pattern -> Either String Pattern)
-> (Text -> Pattern) -> Text -> Either String Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pattern
forall v. Value v => v -> Pattern
Pattern.fromValue (Text -> Either String Pattern) -> Text -> Either String Pattern
forall a b. (a -> b) -> a -> b
$ StringLiteral
s.value
    inlineExpression HashSet Identifier
_ HashMap Identifier SomeValue
_ (AST.NumberLiteralExpression NumberLiteral
n) =
        Pattern -> Either String Pattern
forall a b. b -> Either a b
Right (Pattern -> Either String Pattern)
-> ((Scientific, NumberOptions) -> Pattern)
-> (Scientific, NumberOptions)
-> Either String Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeValue -> Pattern
forall v. Value v => v -> Pattern
Pattern.fromValue (SomeValue -> Pattern)
-> ((Scientific, NumberOptions) -> SomeValue)
-> (Scientific, NumberOptions)
-> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> NumberOptions -> SomeValue)
-> (Scientific, NumberOptions) -> SomeValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Scientific -> NumberOptions -> SomeValue
NumberValue ((Scientific, NumberOptions) -> Either String Pattern)
-> (Scientific, NumberOptions) -> Either String Pattern
forall a b. (a -> b) -> a -> b
$ NumberLiteral -> (Scientific, NumberOptions)
Number.fromLiteral NumberLiteral
n
    inlineExpression HashSet Identifier
followed HashMap Identifier SomeValue
arguments (AST.PlaceableExpression Expression
expr) =
        HashSet Identifier
-> HashMap Identifier SomeValue
-> Expression
-> Either String Pattern
expression HashSet Identifier
followed HashMap Identifier SomeValue
arguments Expression
expr
    inlineExpression HashSet Identifier
_ HashMap Identifier SomeValue
arguments (AST.VariableReference Identifier
id) =
        SomeValue -> Pattern
forall v. Value v => v -> Pattern
Pattern.fromValue
            (SomeValue -> Pattern)
-> Either String SomeValue -> Either String Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe SomeValue -> Either String SomeValue
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)
                (Identifier -> HashMap Identifier SomeValue -> Maybe SomeValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
id HashMap Identifier SomeValue
arguments)
    inlineExpression HashSet Identifier
followed HashMap Identifier SomeValue
arguments (AST.FunctionReference Identifier
id CallArguments
called) = do
        let AST.CallArguments [Either NamedArgument InlineExpression]
args = CallArguments
called
        [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern
f <-
            String
-> Maybe
     ([Pattern]
      -> HashMap Identifier SomeValue -> Either String Pattern)
-> Either
     String
     ([Pattern]
      -> HashMap Identifier SomeValue -> 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 SomeValue -> Either String Pattern)
 -> Either
      String
      ([Pattern]
       -> HashMap Identifier SomeValue -> Either String Pattern))
-> Maybe
     ([Pattern]
      -> HashMap Identifier SomeValue -> Either String Pattern)
-> Either
     String
     ([Pattern]
      -> HashMap Identifier SomeValue -> Either String Pattern)
forall a b. (a -> b) -> a -> b
$
                Identifier
-> HashMap
     Identifier
     ([Pattern]
      -> HashMap Identifier SomeValue -> Either String Pattern)
-> Maybe
     ([Pattern]
      -> HashMap Identifier SomeValue -> 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 SomeValue -> Either String Pattern)
-> Maybe
     ([Pattern]
      -> HashMap Identifier SomeValue -> Either String Pattern)
-> Maybe
     ([Pattern]
      -> HashMap Identifier SomeValue -> 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 SomeValue -> Either String Pattern)
-> Maybe
     ([Pattern]
      -> HashMap Identifier SomeValue -> 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 SomeValue -> 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 -> Either String Pattern)
-> [InlineExpression] -> 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 SomeValue
-> InlineExpression
-> Either String Pattern
inlineExpression HashSet Identifier
followed HashMap Identifier SomeValue
arguments) [InlineExpression]
positional
        [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern
f [Pattern]
positional' (HashMap Identifier SomeValue -> Either String Pattern)
-> ([(Identifier, SomeValue)] -> HashMap Identifier SomeValue)
-> [(Identifier, SomeValue)]
-> Either String Pattern
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 Pattern)
-> [(Identifier, SomeValue)] -> Either String Pattern
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
    inlineExpression HashSet Identifier
followed HashMap Identifier SomeValue
arguments (AST.MessageReference Identifier
id Maybe AttributeAccessor
accessor) = do
        Message
found <-
            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 -> Either String Message)
-> Maybe Message -> 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' <- 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 SomeValue
-> Identifier
-> Pattern
-> Either String Pattern
follow HashSet Identifier
followed HashMap Identifier SomeValue
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 SomeValue
_ (AST.TermReference Identifier
id Maybe AttributeAccessor
accessor Maybe CallArguments
args) = do
        Term
found <- 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 -> Either String Term)
-> Maybe Term -> 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
-> (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 SomeValue
arguments' <- Maybe CallArguments -> Either String (HashMap Identifier SomeValue)
termArguments Maybe CallArguments
args
        HashSet Identifier
-> HashMap Identifier SomeValue
-> Identifier
-> Pattern
-> Either String Pattern
follow HashSet Identifier
followed HashMap Identifier SomeValue
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 SomeValue
        -> Identifier
        -> AST.Pattern
        -> Either String Pattern
    follow :: HashSet Identifier
-> HashMap Identifier SomeValue
-> Identifier
-> Pattern
-> Either String Pattern
follow HashSet Identifier
followed HashMap Identifier SomeValue
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 = String -> Either String Pattern
forall a b. a -> Either a b
Left (String -> Either String Pattern)
-> String -> 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 SomeValue -> Pattern -> 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 SomeValue
arguments Pattern
found