92 lines
2.4 KiB
Haskell
92 lines
2.4 KiB
Haskell
{-# 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"
|