{-# LANGUAGE RankNTypes #-}
{-# 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 (SomeValue, Value (..))
import Prelude

data Reference = Reference
    { Reference -> Either String Identifier
name :: Either String Identifier
    , Reference -> Maybe AttributeAccessor
attribute :: Maybe AttributeAccessor
    , Reference -> HashMap Text SomeValue
arguments :: HashMap Text SomeValue
    , Reference -> [Override]
overrides :: [Bundle.Override]
    }

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 SomeValue
arguments = HashMap Text SomeValue
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)
                (String -> Text
Text.pack String
s)

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 SomeValue
name :: Reference -> Either String Identifier
attribute :: Reference -> Maybe AttributeAccessor
arguments :: Reference -> HashMap Text SomeValue
overrides :: Reference -> [Override]
name :: Either String Identifier
attribute :: Maybe AttributeAccessor
arguments :: HashMap Text SomeValue
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 SomeValue
arguments <-
            [(Identifier, SomeValue)] -> HashMap Identifier SomeValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Identifier, SomeValue)] -> HashMap Identifier SomeValue)
-> Either String [(Identifier, SomeValue)]
-> Either String (HashMap Identifier SomeValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, SomeValue)]
-> ((Text, SomeValue) -> Either String (Identifier, SomeValue))
-> Either String [(Identifier, SomeValue)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashMap Text SomeValue -> [(Text, SomeValue)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text SomeValue
arguments) \(Text
k, SomeValue
v) ->
                Text -> Either String Identifier
Parser.parseIdentifier Text
k Either String Identifier
-> (Identifier -> (Identifier, SomeValue))
-> Either String (Identifier, SomeValue)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,SomeValue
v)
        NonEmpty locale -> Pattern -> Either String Text
forall l. Locale l => NonEmpty l -> Pattern -> Either String Text
forall v l.
(Value v, Locale l) =>
NonEmpty l -> v -> Either String Text
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 SomeValue -> Pattern -> Either String Pattern
forall locale.
Locale locale =>
Bundle locale
-> HashMap Identifier SomeValue -> Pattern -> Either String Pattern
Bundle.pattern Bundle locale
bundle HashMap Identifier SomeValue
arguments Pattern
pat

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

instance (Foldable f, k ~ Text, Value 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 SomeValue
asked = [(k, SomeValue)] -> HashMap k SomeValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(k, SomeValue)] -> HashMap k SomeValue)
-> (f (k, v) -> [(k, SomeValue)])
-> f (k, v)
-> HashMap k SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, SomeValue)) -> [(k, v)] -> [(k, SomeValue)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> SomeValue) -> (k, v) -> (k, SomeValue)
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 -> SomeValue
forall v. Value v => v -> SomeValue
value) ([(k, v)] -> [(k, SomeValue)])
-> (f (k, v) -> [(k, v)]) -> f (k, v) -> [(k, SomeValue)]
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 SomeValue)
-> f (k, v) -> HashMap k SomeValue
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}