module Language.Fluent.Pattern where

import Control.Monad.Extra (mconcatMapM)
import Data.Either (partitionEithers)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (listToMaybe)
import Data.String (IsString (..))
import Data.Text (Text)
import Language.Fluent.AST (Identifier)
import Language.Fluent.AST qualified as AST
import Language.Fluent.Locale (Locale)
import Language.Fluent.Number qualified as Number
import Language.Fluent.Value (ToValue (..), Value)
import Language.Fluent.Value qualified as Value
import Prelude

-- | A t'AST.Pattern' with all the selections and interpolations resolved down to
-- t'Value' and isolation marks.
newtype Pattern = Pattern (NonEmpty PatternElement)
    deriving newtype (NonEmpty Pattern -> Pattern
Pattern -> Pattern -> Pattern
(Pattern -> Pattern -> Pattern)
-> (NonEmpty Pattern -> Pattern)
-> (forall b. Integral b => b -> Pattern -> Pattern)
-> Semigroup Pattern
forall b. Integral b => b -> Pattern -> Pattern
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Pattern -> Pattern -> Pattern
<> :: Pattern -> Pattern -> Pattern
$csconcat :: NonEmpty Pattern -> Pattern
sconcat :: NonEmpty Pattern -> Pattern
$cstimes :: forall b. Integral b => b -> Pattern -> Pattern
stimes :: forall b. Integral b => b -> Pattern -> Pattern
Semigroup, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pattern -> ShowS
showsPrec :: Int -> Pattern -> ShowS
$cshow :: Pattern -> String
show :: Pattern -> String
$cshowList :: [Pattern] -> ShowS
showList :: [Pattern] -> ShowS
Show)

-- | A single piece of a t'Pattern'.
data PatternElement
    = -- | A value, ready to be formatted.
      Value Value
    | -- | A sequence of values surrounded by isolation marks (FSI, PDI).
      Isolated Pattern
    deriving stock (Int -> PatternElement -> ShowS
[PatternElement] -> ShowS
PatternElement -> String
(Int -> PatternElement -> ShowS)
-> (PatternElement -> String)
-> ([PatternElement] -> ShowS)
-> Show PatternElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatternElement -> ShowS
showsPrec :: Int -> PatternElement -> ShowS
$cshow :: PatternElement -> String
show :: PatternElement -> String
$cshowList :: [PatternElement] -> ShowS
showList :: [PatternElement] -> ShowS
Show)

instance IsString Pattern where
    fromString :: String -> Pattern
fromString = NonEmpty PatternElement -> Pattern
Pattern (NonEmpty PatternElement -> Pattern)
-> (String -> NonEmpty PatternElement) -> String -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternElement -> NonEmpty PatternElement
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternElement -> NonEmpty PatternElement)
-> (String -> PatternElement) -> String -> NonEmpty PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PatternElement
forall a. IsString a => String -> a
fromString

instance IsString PatternElement where
    fromString :: String -> PatternElement
fromString = Value -> PatternElement
Value (Value -> PatternElement)
-> (String -> Value) -> String -> PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
forall a. IsString a => String -> a
fromString

-- | Format a pattern for the locales, in order of preference.
format :: (Locale l) => NonEmpty l -> Pattern -> Either String Text
format :: forall l. Locale l => NonEmpty l -> Pattern -> Either String Text
format NonEmpty l
locales (Pattern NonEmpty PatternElement
elements) = (PatternElement -> Either String Text)
-> [PatternElement] -> Either String Text
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mconcatMapM PatternElement -> Either String Text
element ([PatternElement] -> Either String Text)
-> [PatternElement] -> Either String Text
forall a b. (a -> b) -> a -> b
$ NonEmpty PatternElement -> [PatternElement]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty PatternElement
elements
  where
    element :: PatternElement -> Either String Text
element (Value Value
v) = NonEmpty l -> Value -> Either String Text
forall l. Locale l => NonEmpty l -> Value -> Either String Text
Value.format NonEmpty l
locales Value
v
    element (Isolated Pattern
inner) = Text -> Text
isolate (Text -> Text) -> Either String Text -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty l -> Pattern -> Either String Text
forall l. Locale l => NonEmpty l -> Pattern -> Either String Text
format NonEmpty l
locales Pattern
inner

isolate :: Text -> Text
isolate :: Text -> Text
isolate = (Text
"\x2068" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x2069")

fromValue :: (ToValue v) => v -> Pattern
fromValue :: forall v. ToValue v => v -> Pattern
fromValue = NonEmpty PatternElement -> Pattern
Pattern (NonEmpty PatternElement -> Pattern)
-> (v -> NonEmpty PatternElement) -> v -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternElement -> NonEmpty PatternElement
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatternElement -> NonEmpty PatternElement)
-> (v -> PatternElement) -> v -> NonEmpty PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> PatternElement
Value (Value -> PatternElement) -> (v -> Value) -> v -> PatternElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Value
forall v. ToValue v => v -> Value
toValue

attribute :: Identifier -> [AST.Attribute] -> Maybe AST.Pattern
attribute :: Identifier -> [Attribute] -> Maybe Pattern
attribute Identifier
name [Attribute]
attributes =
    [Pattern] -> Maybe Pattern
forall a. [a] -> Maybe a
listToMaybe [Pattern
pattern | AST.Attribute Identifier
name' Pattern
pattern <- [Attribute]
attributes, Identifier
name' Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
name]

termArguments :: Maybe AST.CallArguments -> Either String (HashMap Identifier Value)
termArguments :: Maybe CallArguments -> Either String (HashMap Identifier Value)
termArguments Maybe CallArguments
Nothing = HashMap Identifier Value
-> Either String (HashMap Identifier Value)
forall a b. b -> Either a b
Right HashMap Identifier Value
forall a. Monoid a => a
mempty
termArguments (Just (AST.CallArguments ([Either NamedArgument InlineExpression]
-> ([NamedArgument], [InlineExpression])
forall a b. [Either a b] -> ([a], [b])
partitionEithers -> ([NamedArgument]
named, [InlineExpression]
positional))))
    | [InlineExpression] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InlineExpression]
positional = HashMap Identifier Value
-> Either String (HashMap Identifier Value)
forall a b. b -> Either a b
Right (HashMap Identifier Value
 -> Either String (HashMap Identifier Value))
-> ([(Identifier, Value)] -> HashMap Identifier Value)
-> [(Identifier, Value)]
-> Either String (HashMap Identifier Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Identifier, Value)] -> HashMap Identifier Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Identifier, Value)] -> Either String (HashMap Identifier Value))
-> [(Identifier, Value)]
-> Either String (HashMap Identifier Value)
forall a b. (a -> b) -> a -> b
$ NamedArgument -> (Identifier, Value)
namedArgument (NamedArgument -> (Identifier, Value))
-> [NamedArgument] -> [(Identifier, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedArgument]
named
    | Bool
otherwise = String -> Either String (HashMap Identifier Value)
forall a b. a -> Either a b
Left String
"Positional arguments are not allowed"

namedArgument :: AST.NamedArgument -> (AST.Identifier, Value)
namedArgument :: NamedArgument -> (Identifier, Value)
namedArgument (AST.NamedArgument Identifier
i Either StringLiteral NumberLiteral
l) = (Identifier
i, Either StringLiteral NumberLiteral -> Value
literal Either StringLiteral NumberLiteral
l)

literal :: Either AST.StringLiteral AST.NumberLiteral -> Value
literal :: Either StringLiteral NumberLiteral -> Value
literal (Left StringLiteral
s) = Text -> Value
Value.String StringLiteral
s.value
literal (Right NumberLiteral
n) = (Scientific -> NumberOptions -> Value)
-> (Scientific, NumberOptions) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Scientific -> NumberOptions -> Value
Value.Number ((Scientific, NumberOptions) -> Value)
-> (Scientific, NumberOptions) -> Value
forall a b. (a -> b) -> a -> b
$ NumberLiteral -> (Scientific, NumberOptions)
Number.fromLiteral NumberLiteral
n

variantKey :: AST.Variant -> Value
variantKey :: Variant -> Value
variantKey AST.Variant{key :: Variant -> VariantKey
key = AST.VariantKey (Left NumberLiteral
n)} = (Scientific -> NumberOptions -> Value)
-> (Scientific, NumberOptions) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Scientific -> NumberOptions -> Value
Value.Number ((Scientific, NumberOptions) -> Value)
-> (Scientific, NumberOptions) -> Value
forall a b. (a -> b) -> a -> b
$ NumberLiteral -> (Scientific, NumberOptions)
Number.fromLiteral NumberLiteral
n
variantKey AST.Variant{key :: Variant -> VariantKey
key = AST.VariantKey (Right (AST.Identifier Text
name))} = Text -> Value
Value.String Text
name