{-# OPTIONS_GHC -Wno-name-shadowing #-}

module Language.Fluent.Translate where

import Control.Applicative (optional)
import Data.Bifunctor (second)
import Data.Either.Extra (maybeToEither)
import Data.Foldable qualified as Foldable
import Data.Functor ((<&>))
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Traversable (for)
import Language.Fluent.AST (AttributeAccessor (..), Identifier)
import Language.Fluent.AST qualified as AST
import Language.Fluent.Bundle (Bundle (..))
import Language.Fluent.Bundle qualified as Bundle
import Language.Fluent.Locale (Locale)
import Language.Fluent.Parser qualified as Parser
import Language.Fluent.Pattern qualified as Pattern
import Language.Fluent.Value (ToValue (..), Value)
import Prelude

-- | A target message or attribute lookup. Also carries accumulated variadic parameters.
data Reference = Reference
    { Reference -> Either String Identifier
name :: Either String Identifier
    , Reference -> Maybe AttributeAccessor
attribute :: Maybe AttributeAccessor
    , Reference -> HashMap Text Value
arguments :: HashMap Text Value
    , Reference -> [Override]
overrides :: [Bundle.Override]
    }

-- | Express a 'Reference' as a string literal:
--
-- - @"message_id"@ targets a top-level message.
-- - @"message_id.attribute_name"@ targets a specific attribute.
instance IsString Reference where
    fromString :: String -> Reference
fromString String
s =
        Reference
            { name :: Either String Identifier
name = (Identifier, Maybe AttributeAccessor) -> Identifier
forall a b. (a, b) -> a
fst ((Identifier, Maybe AttributeAccessor) -> Identifier)
-> Either String (Identifier, Maybe AttributeAccessor)
-> Either String Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Identifier, Maybe AttributeAccessor)
parsed
            , attribute :: Maybe AttributeAccessor
attribute = (String -> Maybe AttributeAccessor)
-> ((Identifier, Maybe AttributeAccessor)
    -> Maybe AttributeAccessor)
-> Either String (Identifier, Maybe AttributeAccessor)
-> Maybe AttributeAccessor
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AttributeAccessor -> String -> Maybe AttributeAccessor
forall a b. a -> b -> a
const Maybe AttributeAccessor
forall a. Maybe a
Nothing) (Identifier, Maybe AttributeAccessor) -> Maybe AttributeAccessor
forall a b. (a, b) -> b
snd Either String (Identifier, Maybe AttributeAccessor)
parsed
            , arguments :: HashMap Text Value
arguments = HashMap Text Value
forall a. Monoid a => a
mempty
            , overrides :: [Override]
overrides = []
            }
      where
        parsed :: Either String (Identifier, Maybe AttributeAccessor)
parsed =
            String
-> Parser (Identifier, Maybe AttributeAccessor)
-> Text
-> Either String (Identifier, Maybe AttributeAccessor)
forall a. String -> Parser a -> Text -> Either String a
Parser.parseNamed
                String
"reference"
                ((,) (Identifier
 -> Maybe AttributeAccessor
 -> (Identifier, Maybe AttributeAccessor))
-> Parser Text Identifier
-> Parser
     Text
     (Maybe AttributeAccessor -> (Identifier, Maybe AttributeAccessor))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Identifier
Parser.identifier Parser
  Text
  (Maybe AttributeAccessor -> (Identifier, Maybe AttributeAccessor))
-> Parser Text (Maybe AttributeAccessor)
-> Parser (Identifier, Maybe AttributeAccessor)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text AttributeAccessor
-> Parser Text (Maybe AttributeAccessor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text AttributeAccessor
Parser.attributeAccessor)
                (Text -> Either String (Identifier, Maybe AttributeAccessor))
-> Text -> Either String (Identifier, Maybe AttributeAccessor)
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
s

-- | Brings together a message reference, any number of arguments, and a bundle to form a complete
-- translation.
--
-- Instances of this class address three orthogonal concerns:
--
-- - Argument collection. Messages may require arguments before they can be translated.
--   These arguments may be passed directly or resolved implicitly from context.
-- - Bundle resolution. Ultimately all translations come from a bundle.
--   This bundle may be passed directly or resolved implicitly from context.
-- - Return type. Determines a translation's output structure and its failure semantics.
--
-- === Examples:
--
-- > -- Explicit bundle with arguments, returning an Either for safe error handling.
-- > result :: Either String Text
-- > result = translate "welcome" ("name", "Alice") bundle
--
-- > -- Rendering directly to a Miso View, which provides the bundle through the Context.
-- > view :: View Context props model action
-- > view = translate "title"
class Translate r where translate :: Reference -> r

instance (Locale locale) => Translate (Bundle locale -> Either String Text) where
    translate :: Reference -> Bundle locale -> Either String Text
translate Reference{[Override]
Maybe AttributeAccessor
Either String Identifier
HashMap Text Value
name :: Reference -> Either String Identifier
attribute :: Reference -> Maybe AttributeAccessor
arguments :: Reference -> HashMap Text Value
overrides :: Reference -> [Override]
name :: Either String Identifier
attribute :: Maybe AttributeAccessor
arguments :: HashMap Text Value
overrides :: [Override]
..} ((Bundle locale -> [Override] -> Bundle locale)
-> [Override] -> Bundle locale -> Bundle locale
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Override -> Bundle locale -> Bundle locale)
-> Bundle locale -> [Override] -> Bundle locale
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Override -> Bundle locale -> Bundle locale
forall locale. Override -> Bundle locale -> Bundle locale
Bundle.override) [Override]
overrides -> Bundle locale
bundle) = do
        Identifier
name <- Either String Identifier
name
        Message
message <- String -> Maybe Message -> Either String Message
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Message not found: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
name) (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
Bundle.message Identifier
name Bundle locale
bundle
        Pattern
pat <- case Maybe AttributeAccessor
attribute 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 -> String -> String
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
name) Message
message.value
            Just (AttributeAccessor Identifier
attribute) ->
                String -> Maybe Pattern -> Either String Pattern
forall a b. a -> Maybe b -> Either a b
maybeToEither (String
"Attribute not found: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
attribute) (Maybe Pattern -> Either String Pattern)
-> Maybe Pattern -> Either String Pattern
forall a b. (a -> b) -> a -> b
$
                    Identifier -> [Attribute] -> Maybe Pattern
Pattern.attribute Identifier
attribute Message
message.attributes
        HashMap Identifier Value
arguments <-
            [(Identifier, Value)] -> HashMap Identifier Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Identifier, Value)] -> HashMap Identifier Value)
-> Either String [(Identifier, Value)]
-> Either String (HashMap Identifier Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Value)]
-> ((Text, Value) -> Either String (Identifier, Value))
-> Either String [(Identifier, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
arguments) \(Text
k, Value
v) ->
                Text -> Either String Identifier
Parser.parseIdentifier Text
k Either String Identifier
-> (Identifier -> (Identifier, Value))
-> Either String (Identifier, Value)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,Value
v)
        NonEmpty locale -> Pattern -> Either String Text
forall l. Locale l => NonEmpty l -> Pattern -> Either String Text
Pattern.format Bundle locale
bundle.locales (Pattern -> Either String Text)
-> Either String Pattern -> Either String Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bundle locale
-> HashMap Identifier Value -> Pattern -> Either String Pattern
forall locale.
Locale locale =>
Bundle locale
-> HashMap Identifier Value -> Pattern -> Either String Pattern
Bundle.pattern Bundle locale
bundle HashMap Identifier Value
arguments Pattern
pat

instance (k ~ Text, ToValue v, Translate r) => Translate ((k, v) -> r) where
    translate :: Reference -> (k, v) -> r
translate Reference
reference (k
k, v -> Value
forall v. ToValue v => v -> Value
toValue -> Value
v) =
        Reference -> r
forall r. Translate r => Reference -> r
translate Reference
reference{arguments = HashMap.insert k v reference.arguments}

instance (Foldable f, k ~ Text, ToValue v, Translate r) => Translate (f (k, v) -> r) where
    translate :: Reference -> f (k, v) -> r
translate Reference
reference f (k, v)
args =
        Reference -> r
forall r. Translate r => Reference -> r
translate Reference
reference{arguments = HashMap.union asked reference.arguments}
      where
        asked :: HashMap k Value
asked = [(k, Value)] -> HashMap k Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(k, Value)] -> HashMap k Value)
-> (f (k, v) -> [(k, Value)]) -> f (k, v) -> HashMap k Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, Value)) -> [(k, v)] -> [(k, Value)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> Value) -> (k, v) -> (k, Value)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second v -> Value
forall v. ToValue v => v -> Value
toValue) ([(k, v)] -> [(k, Value)])
-> (f (k, v) -> [(k, v)]) -> f (k, v) -> [(k, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (k, v) -> [(k, v)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (f (k, v) -> HashMap k Value) -> f (k, v) -> HashMap k Value
forall a b. (a -> b) -> a -> b
$ f (k, v)
args

instance (Translate r) => Translate (Bundle.Override -> r) where
    translate :: Reference -> Override -> r
translate Reference
reference Override
override = Reference -> r
forall r. Translate r => Reference -> r
translate Reference
reference{overrides = override : reference.overrides}