{-# LANGUAGE UndecidableInstances #-}

module Mensam.API.Aeson.StaticText where

import Mensam.API.Aeson.StaticText.Internal ()
import Mensam.API.Aeson.StaticText.Internal.Union qualified as Union

import Data.Aeson qualified as A
import Data.Kind
import Data.Proxy
import Data.SOP qualified as SOP
import Data.Text qualified as T
import GHC.Generics
import GHC.TypeLits

type StaticText :: Symbol -> Type
data StaticText text = MkStaticText
  deriving stock (StaticText text -> StaticText text -> Bool
(StaticText text -> StaticText text -> Bool)
-> (StaticText text -> StaticText text -> Bool)
-> Eq (StaticText text)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (text :: Symbol). StaticText text -> StaticText text -> Bool
$c== :: forall (text :: Symbol). StaticText text -> StaticText text -> Bool
== :: StaticText text -> StaticText text -> Bool
$c/= :: forall (text :: Symbol). StaticText text -> StaticText text -> Bool
/= :: StaticText text -> StaticText text -> Bool
Eq, (forall x. StaticText text -> Rep (StaticText text) x)
-> (forall x. Rep (StaticText text) x -> StaticText text)
-> Generic (StaticText text)
forall x. Rep (StaticText text) x -> StaticText text
forall x. StaticText text -> Rep (StaticText text) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (text :: Symbol) x.
Rep (StaticText text) x -> StaticText text
forall (text :: Symbol) x.
StaticText text -> Rep (StaticText text) x
$cfrom :: forall (text :: Symbol) x.
StaticText text -> Rep (StaticText text) x
from :: forall x. StaticText text -> Rep (StaticText text) x
$cto :: forall (text :: Symbol) x.
Rep (StaticText text) x -> StaticText text
to :: forall x. Rep (StaticText text) x -> StaticText text
Generic, Eq (StaticText text)
Eq (StaticText text) =>
(StaticText text -> StaticText text -> Ordering)
-> (StaticText text -> StaticText text -> Bool)
-> (StaticText text -> StaticText text -> Bool)
-> (StaticText text -> StaticText text -> Bool)
-> (StaticText text -> StaticText text -> Bool)
-> (StaticText text -> StaticText text -> StaticText text)
-> (StaticText text -> StaticText text -> StaticText text)
-> Ord (StaticText text)
StaticText text -> StaticText text -> Bool
StaticText text -> StaticText text -> Ordering
StaticText text -> StaticText text -> StaticText text
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (text :: Symbol). Eq (StaticText text)
forall (text :: Symbol). StaticText text -> StaticText text -> Bool
forall (text :: Symbol).
StaticText text -> StaticText text -> Ordering
forall (text :: Symbol).
StaticText text -> StaticText text -> StaticText text
$ccompare :: forall (text :: Symbol).
StaticText text -> StaticText text -> Ordering
compare :: StaticText text -> StaticText text -> Ordering
$c< :: forall (text :: Symbol). StaticText text -> StaticText text -> Bool
< :: StaticText text -> StaticText text -> Bool
$c<= :: forall (text :: Symbol). StaticText text -> StaticText text -> Bool
<= :: StaticText text -> StaticText text -> Bool
$c> :: forall (text :: Symbol). StaticText text -> StaticText text -> Bool
> :: StaticText text -> StaticText text -> Bool
$c>= :: forall (text :: Symbol). StaticText text -> StaticText text -> Bool
>= :: StaticText text -> StaticText text -> Bool
$cmax :: forall (text :: Symbol).
StaticText text -> StaticText text -> StaticText text
max :: StaticText text -> StaticText text -> StaticText text
$cmin :: forall (text :: Symbol).
StaticText text -> StaticText text -> StaticText text
min :: StaticText text -> StaticText text -> StaticText text
Ord, ReadPrec [StaticText text]
ReadPrec (StaticText text)
Int -> ReadS (StaticText text)
ReadS [StaticText text]
(Int -> ReadS (StaticText text))
-> ReadS [StaticText text]
-> ReadPrec (StaticText text)
-> ReadPrec [StaticText text]
-> Read (StaticText text)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (text :: Symbol). ReadPrec [StaticText text]
forall (text :: Symbol). ReadPrec (StaticText text)
forall (text :: Symbol). Int -> ReadS (StaticText text)
forall (text :: Symbol). ReadS [StaticText text]
$creadsPrec :: forall (text :: Symbol). Int -> ReadS (StaticText text)
readsPrec :: Int -> ReadS (StaticText text)
$creadList :: forall (text :: Symbol). ReadS [StaticText text]
readList :: ReadS [StaticText text]
$creadPrec :: forall (text :: Symbol). ReadPrec (StaticText text)
readPrec :: ReadPrec (StaticText text)
$creadListPrec :: forall (text :: Symbol). ReadPrec [StaticText text]
readListPrec :: ReadPrec [StaticText text]
Read, Int -> StaticText text -> ShowS
[StaticText text] -> ShowS
StaticText text -> String
(Int -> StaticText text -> ShowS)
-> (StaticText text -> String)
-> ([StaticText text] -> ShowS)
-> Show (StaticText text)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (text :: Symbol). Int -> StaticText text -> ShowS
forall (text :: Symbol). [StaticText text] -> ShowS
forall (text :: Symbol). StaticText text -> String
$cshowsPrec :: forall (text :: Symbol). Int -> StaticText text -> ShowS
showsPrec :: Int -> StaticText text -> ShowS
$cshow :: forall (text :: Symbol). StaticText text -> String
show :: StaticText text -> String
$cshowList :: forall (text :: Symbol). [StaticText text] -> ShowS
showList :: [StaticText text] -> ShowS
Show)

instance KnownSymbol text => A.FromJSON (StaticText text) where
  parseJSON :: Value -> Parser (StaticText text)
parseJSON = String
-> (Text -> Parser (StaticText text))
-> Value
-> Parser (StaticText text)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText (String
"(StaticText " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") ((Text -> Parser (StaticText text))
 -> Value -> Parser (StaticText text))
-> (Text -> Parser (StaticText text))
-> Value
-> Parser (StaticText text)
forall a b. (a -> b) -> a -> b
$ \Text
jsonTxt ->
    if Text
jsonTxt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
txt
      then StaticText text -> Parser (StaticText text)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StaticText text
forall (text :: Symbol). StaticText text
MkStaticText
      else String -> Parser (StaticText text)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (StaticText text))
-> String -> Parser (StaticText text)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected static text. Expected :" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
str
   where
    str :: String
str = Proxy text -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @text)
    txt :: Text
txt = String -> Text
T.pack String
str

instance KnownSymbol text => A.ToJSON (StaticText text) where
  toJSON :: StaticText text -> Value
toJSON StaticText text
MkStaticText = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy text -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @text)

type StaticTexts :: [Symbol] -> Type
newtype StaticTexts texts = MkStaticTexts {forall (texts :: [Symbol]).
StaticTexts texts -> Union (Map StaticText texts)
unStaticTexts :: Union.Union (Union.Map StaticText texts)}

deriving stock instance SOP.All (SOP.Compose Eq SOP.I) (Union.Map StaticText texts) => Eq (StaticTexts texts)
deriving stock instance SOP.All (SOP.Compose Show SOP.I) (Union.Map StaticText texts) => Show (StaticTexts texts)
deriving stock instance (SOP.All (SOP.Compose Eq SOP.I) (Union.Map StaticText texts), SOP.All (SOP.Compose Ord SOP.I) (Union.Map StaticText texts)) => Ord (StaticTexts texts)
deriving stock instance Read (StaticTexts '[])
deriving stock instance (Read (StaticText text), Read (SOP.NS SOP.I (Union.Map StaticText texts))) => Read (StaticTexts (text : texts))

deriving newtype instance A.ToJSON (StaticTexts '[])
deriving newtype instance (A.ToJSON (StaticText text), A.ToJSON (SOP.NS SOP.I (Union.Map StaticText texts)), Union.Unique (Union.Map StaticText (text : texts))) => A.ToJSON (StaticTexts (text : texts))

deriving newtype instance A.FromJSON (StaticTexts '[])
deriving newtype instance (A.FromJSON (StaticText text), A.FromJSON (SOP.NS SOP.I (Union.Map StaticText texts)), Union.Unique (Union.Map StaticText (text : texts))) => A.FromJSON (StaticTexts (text : texts))

specificStaticText :: forall texts text. Union.IsMember (StaticText text) (Union.Map StaticText texts) => StaticText text -> StaticTexts texts
specificStaticText :: forall (texts :: [Symbol]) (text :: Symbol).
IsMember (StaticText text) (Map StaticText texts) =>
StaticText text -> StaticTexts texts
specificStaticText StaticText text
staticText = Union (Map StaticText texts) -> StaticTexts texts
forall (texts :: [Symbol]).
Union (Map StaticText texts) -> StaticTexts texts
MkStaticTexts (Union (Map StaticText texts) -> StaticTexts texts)
-> Union (Map StaticText texts) -> StaticTexts texts
forall a b. (a -> b) -> a -> b
$ I (StaticText text) -> Union (Map StaticText texts)
forall k (x :: k) (xs :: [k]) (f :: k -> *).
UElem x xs =>
f x -> NS f xs
forall (f :: * -> *).
f (StaticText text) -> NS f (Map StaticText texts)
Union.inject (I (StaticText text) -> Union (Map StaticText texts))
-> I (StaticText text) -> Union (Map StaticText texts)
forall a b. (a -> b) -> a -> b
$ StaticText text -> I (StaticText text)
forall a. a -> I a
SOP.I StaticText text
staticText