zgo-backend/src/LangComponent.hs

{-# LANGUAGE OverloadedStrings #-}

module LangComponent where

import Data.Aeson
import Data.Aeson.KeyMap
import qualified Data.Bson as B
import Data.ByteString.Builder.Extra (AllocationStrategy)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Database.MongoDB
import Xero (Xero(x_clientId))

-- | Type to represent a UI components text variables in different languages
data LangComponent =
  LangComponent
    { lc_id :: Maybe ObjectId
    , lc_lang :: T.Text
    , lc_component :: T.Text
    , lc_data :: Data.Aeson.Object
    }
  deriving (Show, Eq)

instance ToJSON LangComponent where
  toJSON (LangComponent i l c d) =
    case i of
      Just oid ->
        object
          ["_id" .= show oid, "language" .= l, "component" .= c, "data" .= d]
      Nothing ->
        object
          [ "_id" .= ("" :: String)
          , "language" .= l
          , "component" .= c
          , "data" .= d
          ]

instance FromJSON LangComponent where
  parseJSON =
    withObject "LangComponent" $ \obj -> do
      l <- obj .: "language"
      c <- obj .: "component"
      d <- obj .: "data"
      pure $ LangComponent Nothing l c d

instance Val LangComponent where
  val (LangComponent i l c d) =
    if isJust i
      then Doc
             [ "_id" =: i
             , "language" =: l
             , "component" =: c
             , "data" =: (TL.toStrict . TLE.decodeUtf8 . encode) d
             ]
      else Doc
             [ "language" =: l
             , "component" =: c
             , "data" =: (TL.toStrict . TLE.decodeUtf8 . encode) d
             ]
  cast' (Doc d) = do
    i <- B.lookup "_id" d
    l <- B.lookup "language" d
    c <- B.lookup "component" d
    dt <- B.lookup "data" d
    pure $
      LangComponent
        i
        l
        c
        (fromMaybe
           Data.Aeson.KeyMap.empty
           ((decode . TLE.encodeUtf8 . TL.fromStrict) dt))

-- Database Actions
findLangComponent :: T.Text -> T.Text -> Action IO (Maybe Document)
findLangComponent lang component =
  findOne (select ["language" =: lang, "component" =: component] "langcomps")

loadLangComponent :: LangComponent -> Action IO ()
loadLangComponent lc = do
  let langComp = val lc
  case langComp of
    Doc x ->
      upsert
        (select
           ["language" =: lc_lang lc, "component" =: lc_component lc]
           "langcomps")
        x
    _ -> error "Couldn't parse language JSON"