Fluent.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- |
-- Module      : Miso.Fluent
-- Copyright   : (c) 2026 Institute for Digital Autonomy
-- License     : EUPL-1.2
-- Maintainer  : IDA
--
-- In-browser <https://projectfluent.org Project Fluent> localisation backed by
-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl Intl>.
--
-- This module re-exports everything needed to translate Fluent messages.
--
-- = Quickstart
--
-- == 1. Parsing resources
--
-- Embed Fluent resources at compile time using the 'fluent' quasi-quoter:
--
-- > let resource =
-- >         [fluent|
-- >            greeting = Hello!
-- >            welcome = Welcome, { $name }
-- >         |]
--
-- Or parse Fluent source at runtime from an asynchronous 'getText' request:
--
-- > getText "/static/en-GB.ftl" []
-- >     (\res -> SetResource $ Fluent.parse Fluent.resource (body res))
-- >     (\err -> SetResource $ Left "Failed to fetch .ftl file")
--
-- == 2. Building bundles
--
-- Combine 'Resource's and 'Locale's into a 'Bundle' using 'bundle':
--
-- > let english = bundle @Locale (pure "en-GB") [resource]
--
-- == 3. Translating
--
-- 'translate' is overloaded on its return type, allowing a message to be translated
-- into a plain 'MisoString' or directly into a 'View'.
--
-- === To 'MisoString'
--
-- Translate directly against a 'Bundle':
--
-- > translate "welcome" ("name", "Ann" :: MisoString) (UseIsolating False) english :: Either String MisoString
-- > -- Right "Welcome, Ann"
--
-- If you request a plain 'MisoString' instead of 'Either', errors are logged to the
-- browser console and the error message is returned as fallback text:
--
-- > translate "welcome" ("name", "Ann" :: MisoString) english :: MisoString
-- > -- "Welcome, Ann"
--
-- === To 'View'
--
-- When returning a 'View', 'translate' automatically retrieves the 'Bundle' from the ambient Miso context,
-- which must implement 'Fluent':
--
-- > data Context = Context { bundle :: Bundle Locale }
-- >    deriving anyclass (Fluent)
--
-- Render directly to a text node:
--
-- > greeting :: View Context props model action
-- > greeting = translate "greeting"
--
-- Pass a continuation to customise element wrapping:
--
-- > welcome :: View Context props model action
-- > welcome = translate "welcome" ("name", "Ann" :: MisoString) \msg ->
-- >     p_ [] [text msg]
--
-- Or accept an 'Either' in the continuation to handle translation failures explicitly:
--
-- > welcome :: View Context props model action
-- > welcome = translate "welcome" ("name", "Ann" :: MisoString) \case
-- >     Right msg -> p_ [] [text msg]
-- >     Left err  -> p_ [class_ "error"] [text $ toMisoString err]
module Miso.Fluent
    ( Fluent (..)
    , Locale (..)

      -- * Re-exports
    , module Language.Fluent
    )
where

import Data.String (IsString (..))
import Data.Text (Text)
import GHC.Records (HasField)
import Language.Fluent hiding (Locale)
import Miso.Fluent.Intl (Locale (..))
import Miso.Prelude hiding (context, props)
import Miso.String (FromMisoString (..))
import Miso.Trace (traceErrorId)

-- | Types that can supply a translation 'Bundle'.
--
-- This is usually a context or a model type.
class Fluent f where
    getBundle :: f -> Bundle Locale
    default getBundle :: (HasField "bundle" f (Bundle Locale)) => f -> Bundle Locale
    getBundle = (.bundle)

instance Fluent (Bundle Locale) where
    getBundle = id

instance FromMisoString SomeValue where
    fromMisoStringEither = fmap StringValue . fromMisoStringEither

instance FromMisoString Reference where
    fromMisoStringEither = Right . fromString . fromMisoString

#ifndef VANILLA
instance Value MisoString where value = value . fromMisoString @Text
#endif

instance {-# OVERLAPPABLE #-} (Fluent context) => Translate (context -> Either String MisoString) where
    translate ref context = toMisoString @Text <$> translate ref (getBundle context)

instance
    (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')
    => Translate
        ((Either String MisoString -> View context' props' model' action') -> View context props model action)
    where
    translate ref f = withContext \(getBundle -> bundle) -> f $ translate ref bundle

instance
    (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')
    => Translate
        ( (Either String MisoString -> [View context' props' model' action'])
          -> View context props model action
        )
    where
    translate ref f = translate ref $ fragment . f

instance
    (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')
    => Translate ((MisoString -> [View context' props' model' action']) -> View context props model action)
    where
    translate ref f = translate ref $ f . either (traceErrorId . toMisoString @String) id

instance (Fluent context) => Translate (context -> MisoString) where
    translate ref = either (traceErrorId . toMisoString @String) id . translate ref

instance
    (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')
    => Translate ((MisoString -> View context' props' model' action') -> View context props model action)
    where
    translate ref f = translate ref $ pure @[] . f

instance (Fluent context) => Translate (View context props model action) where
    translate ref = translate ref text