Multi.hs

{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      : Effectful.Fluent.Multi
-- Copyright   : (c) 2026 Institute for Digital Autonomy
-- License     : EUPL-1.2
-- Maintainer  : IDA
--
-- <https://projectfluent.org Project Fluent> translation support for the
-- <https://hackage.haskell.org/package/effectful Effectful> ecosystem, for applications
-- targeting multiple languages.
--
-- This module provides the 'Fluent' effect and 'runFluent' interpreter to translate
-- messages against a single 'Bundle'.
--
-- This library does not provide any concrete instances of 'Locale'.
-- Pair it with a locale provider such as <https://hackage.haskell.org/package/fluent-icu fluent-icu>.
--
-- = Quickstart
--
-- == 1. Parsing resources
--
-- Embed Fluent resources at compile time using the 'fluent' quasi-quoter:
--
-- > let enRes = [fluent|welcome = Welcome, { $name }|]
-- >     deRes = [fluent|welcome = Willkommen, { $name }|]
--
-- Or parse Fluent source at runtime with 'parseResource':
--
-- > enRes <- either fail pure . parseResource =<< Text.readFile "en-GB.ftl"
-- > deRes <- either fail pure . parseResource =<< Text.readFile "de-CH.ftl"
--
-- == 2. Building bundles
--
-- Combine 'Resource's and 'Locale's into 'Bundle's using 'bundle':
--
-- > let enGB, deCH :: LocaleName
-- >     enGB = "en-GB"
-- >     deCH = "de-CH"
-- >     english = bundle @LocaleName (pure enGB) [enRes]
-- >     swiss   = bundle @LocaleName (pure deCH) [deRes]
--
-- == 3. Running the effect
--
-- Pass the collection of 'Bundle's to 'runFluent'. Translations select the bundle matching
-- the target locale supplied to 'translate':
--
-- > main :: IO ()
-- > main = runEff . runFluent [english, swiss] $ do
-- >     translate "welcome" ("name", value @Text "Ann") enGB >>= liftIO . print
-- >     -- Right "Welcome, Ann"
-- >     translate "welcome" ("name", value @Text "Ann") deCH >>= liftIO . print
-- >     -- Right "Willkommen, Ann"
module Effectful.Fluent.Multi
    ( -- * Effect
      Fluent
    , runFluent

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

import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text (Text)
import Data.Text qualified as Text
import Effectful
import Effectful.Dispatch.Static (SideEffects (..), StaticRep, evalStaticRep, getStaticRep)
import Language.Fluent
import Language.Fluent.Locale qualified as Locale
import Prelude

-- | Translates from a t'Bundle' per locale, chosen by the locale passed to 'translate'.
data Fluent :: Effect

type instance DispatchOf Fluent = 'Static 'NoSideEffects

data instance StaticRep Fluent where
    Fluent :: (Locale locale) => HashMap Text (Bundle locale) -> StaticRep Fluent

-- | Translate with the given t'Bundle's in the effectful computation.
-- Each bundle is known by the first of its locales.
runFluent :: (Locale locale) => [Bundle locale] -> Eff (Fluent ': es) a -> Eff es a
runFluent =
    evalStaticRep
        . Fluent
        . foldr (\bundle -> HashMap.insert (Locale.toCode $ NonEmpty.head bundle.locales) bundle) mempty

instance (Locale locale, Fluent :> es, r ~ Either String Text) => Translate (locale -> Eff es r) where
    translate ref (Locale.toCode -> locale) = do
        Fluent bundles <- getStaticRep
        pure $ case HashMap.lookup locale bundles of
            Nothing -> Left . Text.unpack $ "No bundle for locale " <> locale
            Just bundle -> translate ref bundle