Translate.hs

{-# 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
    { name :: Either String Identifier
    , attribute :: Maybe AttributeAccessor
    , arguments :: HashMap Text SomeValue
    , overrides :: [Bundle.Override]
    }

instance IsString Reference where
    fromString s =
        Reference
            { name = fst <$> parsed
            , attribute = either (const Nothing) snd parsed
            , arguments = mempty
            , overrides = []
            }
      where
        parsed =
            Parser.parseNamed
                "reference"
                ((,) <$> Parser.identifier <*> optional Parser.attributeAccessor)
                (Text.pack s)

class Translate r where translate :: Reference -> r

instance (Locale locale) => Translate (Bundle locale -> Either String Text) where
    translate Reference{..} (flip (foldr Bundle.override) overrides -> bundle) = do
        name <- name
        message <- maybeToEither ("Message not found: " <> show name) $ Bundle.message name bundle
        pat <- case attribute of
            Nothing ->
                maybeToEither ("Message has no value: " <> show name) message.value
            Just (AttributeAccessor attribute) ->
                maybeToEither ("Attribute not found: " <> show attribute) $
                    Pattern.attribute attribute message.attributes
        arguments <-
            HashMap.fromList <$> for (HashMap.toList arguments) \(k, v) ->
                Parser.parseIdentifier k <&> (,v)
        format bundle.locales =<< Bundle.pattern bundle arguments pat

instance (k ~ Text, Value v, Translate r) => Translate ((k, v) -> r) where
    translate reference (k, value -> v) =
        translate 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 args =
        translate reference{arguments = HashMap.union asked reference.arguments}
      where
        asked = HashMap.fromList . fmap (second value) . Foldable.toList $ args

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