{-# OPTIONS_GHC -O0 #-}
# LANGUAGE DeriveGeneric , OverloadedStrings , OverloadedLabels #
module Tests.JSON (jsonTests, jsonQueryTests) where
import Database.Selda hiding (Result)
import Database.Selda.JSON
import Database.Selda.Nullable (nonNull)
import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Lazy as BSL (fromStrict)
import Data.Text.Encoding (encodeUtf8)
import Data.List (sort)
import Test.HUnit
import Tables (Person (..), peopleItems)
import Utils

data JSONPerson = JSONPerson
  { id :: ID JSONPerson
  , nameKey :: Text
  , json :: Value
  } deriving Generic
instance SqlRow JSONPerson

instance ToJSON Person
instance FromJSON Person

flipWithM_ :: Monad m => [a] -> [b] -> (a -> b -> m c) -> m ()
flipWithM_ xs ys f = zipWithM_ f xs ys

jsonPeople :: Table JSONPerson
jsonPeople = table "jsonPeople" [#id :- autoPrimary]

jsonTests :: (SeldaM b () -> IO ()) -> Test
jsonTests freshEnv = test
  [ "json is properly inserted"    ~: freshEnv insertJson
  , "json is properly returned"    ~: freshEnv selectJson
  ]

jsonQueryTests :: JSONBackend b => (SeldaM b () -> IO ()) -> Test
jsonQueryTests freshEnv = test
  [ "can select json properties"   ~: freshEnv selectJsonProp
  , "select dynamic json property" ~: freshEnv selectJsonPropDynamic
  , "convert json to string"       ~: freshEnv json2String
  , "missing property yields null" ~: freshEnv missingProp
  , "chained lookup"               ~: freshEnv chainedLookup
  ]


numPeopleItems :: Int
numPeopleItems = length peopleItems

withJsonTable :: (Int -> SeldaM b a) -> SeldaM b a
withJsonTable go = do
  tryDropTable jsonPeople
  createTable jsonPeople
  count <- insert jsonPeople $ map (JSONPerson def "name" . toJSON) peopleItems
  x <- go count
  dropTable jsonPeople
  return x

withJsonTable' :: SeldaM b a -> SeldaM b a
withJsonTable' go = withJsonTable (const go)

insertJson =
  withJsonTable $ assEq "wrong number of rows inserted" numPeopleItems

selectJson = withJsonTable' $ do
  vals <- query $ #json `from` select jsonPeople
  let vals' = [v | Success v <- map fromJSON vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  flipWithM_ (sort peopleItems) (sort vals') $ \expected actual -> do
    assEq "got wrong element from query" expected actual

selectJsonProp :: JSONBackend b => SeldaM b ()
selectJsonProp = withJsonTable' $ do
  vals <- query $ do
    json_person <- #json `from` select jsonPeople
    return $ json_person ~> "name"
  let vals' = [s | Just (String s) <- vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  assEq "wrong list of names returned" (sort $ map name peopleItems) (sort vals')

selectJsonPropDynamic :: JSONBackend b => SeldaM b ()
selectJsonPropDynamic = withJsonTable' $ do
  vals <- query $ do
    person <- select jsonPeople
    return $ person ! #json ~> person ! #nameKey
  let vals' = [s | Just (String s) <- vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  assEq "wrong list of names returned" (sort $ map name peopleItems) (sort vals')

json2String :: JSONBackend b => SeldaM b ()
json2String = withJsonTable' $ do
  vals <- query $ do
    json_person <- #json `from` select jsonPeople
    return $ jsonToText json_person
  let vals' = [x | Just x <- map (decode . BSL.fromStrict . encodeUtf8) vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  assEq "wrong list of people returned" (sort peopleItems) (sort vals')

missingProp :: JSONBackend b => SeldaM b ()
missingProp = withJsonTable' $ do
  vals <- query $ do
    json_person <- #json `from` select jsonPeople
    return $ json_person ~> "this property does not exist"
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  forM_ vals $ \actual -> do
    assEq "some rows were not null" Nothing actual

chainedLookup :: JSONBackend b => SeldaM b ()
chainedLookup = withJsonTable' $ do
    update jsonPeople (const true) (`with` [#json := literal newJson])
    val <- fmap head . query $ do
      json_person <- #json `from` select jsonPeople
      x <- nonNull (json_person ~> "foo" ~> "bar")
      return (jsonToText x)
    assEq "wrong value returned" "42" val
  where
    Just newJson = decode "{\"foo\": {\"bar\": 42}}" :: Maybe Value

# OPTIONS_GHC -O0 #
# LANGUAGE DeriveGeneric , OverloadedStrings , OverloadedLabels #
module Tests.JSON (jsonTests, jsonQueryTests) where
import Database.Selda hiding (Result)
import Database.Selda.JSON
import Database.Selda.Nullable (nonNull)
import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Lazy as BSL (fromStrict)
import Data.Text.Encoding (encodeUtf8)
import Data.List (sort)
import Test.HUnit
import Tables (Person (..), peopleItems)
import Utils

data JSONPerson = JSONPerson
  { id :: ID JSONPerson
  , nameKey :: Text
  , json :: Value
  } deriving Generic
instance SqlRow JSONPerson

instance ToJSON Person
instance FromJSON Person

flipWithM_ :: Monad m => [a] -> [b] -> (a -> b -> m c) -> m ()
flipWithM_ xs ys f = zipWithM_ f xs ys

jsonPeople :: Table JSONPerson
jsonPeople = table "jsonPeople" [#id :- autoPrimary]

jsonTests :: (SeldaM b () -> IO ()) -> Test
jsonTests freshEnv = test
  [ "json is properly inserted"    ~: freshEnv insertJson
  , "json is properly returned"    ~: freshEnv selectJson
  ]

jsonQueryTests :: JSONBackend b => (SeldaM b () -> IO ()) -> Test
jsonQueryTests freshEnv = test
  [ "can select json properties"   ~: freshEnv selectJsonProp
  , "select dynamic json property" ~: freshEnv selectJsonPropDynamic
  , "convert json to string"       ~: freshEnv json2String
  , "missing property yields null" ~: freshEnv missingProp
  , "chained lookup"               ~: freshEnv chainedLookup
  ]


numPeopleItems :: Int
numPeopleItems = length peopleItems

withJsonTable :: (Int -> SeldaM b a) -> SeldaM b a
withJsonTable go = do
  tryDropTable jsonPeople
  createTable jsonPeople
  count <- insert jsonPeople $ map (JSONPerson def "name" . toJSON) peopleItems
  x <- go count
  dropTable jsonPeople
  return x

withJsonTable' :: SeldaM b a -> SeldaM b a
withJsonTable' go = withJsonTable (const go)

insertJson =
  withJsonTable $ assEq "wrong number of rows inserted" numPeopleItems

selectJson = withJsonTable' $ do
  vals <- query $ #json `from` select jsonPeople
  let vals' = [v | Success v <- map fromJSON vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  flipWithM_ (sort peopleItems) (sort vals') $ \expected actual -> do
    assEq "got wrong element from query" expected actual

selectJsonProp :: JSONBackend b => SeldaM b ()
selectJsonProp = withJsonTable' $ do
  vals <- query $ do
    json_person <- #json `from` select jsonPeople
    return $ json_person ~> "name"
  let vals' = [s | Just (String s) <- vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  assEq "wrong list of names returned" (sort $ map name peopleItems) (sort vals')

selectJsonPropDynamic :: JSONBackend b => SeldaM b ()
selectJsonPropDynamic = withJsonTable' $ do
  vals <- query $ do
    person <- select jsonPeople
    return $ person ! #json ~> person ! #nameKey
  let vals' = [s | Just (String s) <- vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  assEq "wrong list of names returned" (sort $ map name peopleItems) (sort vals')

json2String :: JSONBackend b => SeldaM b ()
json2String = withJsonTable' $ do
  vals <- query $ do
    json_person <- #json `from` select jsonPeople
    return $ jsonToText json_person
  let vals' = [x | Just x <- map (decode . BSL.fromStrict . encodeUtf8) vals]
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  assEq "some json conversions failed" (length vals) (length vals')
  assEq "wrong list of people returned" (sort peopleItems) (sort vals')

missingProp :: JSONBackend b => SeldaM b ()
missingProp = withJsonTable' $ do
  vals <- query $ do
    json_person <- #json `from` select jsonPeople
    return $ json_person ~> "this property does not exist"
  assEq "wrong number of rows returned" numPeopleItems (length vals)
  forM_ vals $ \actual -> do
    assEq "some rows were not null" Nothing actual

chainedLookup :: JSONBackend b => SeldaM b ()
chainedLookup = withJsonTable' $ do
    update jsonPeople (const true) (`with` [#json := literal newJson])
    val <- fmap head . query $ do
      json_person <- #json `from` select jsonPeople
      x <- nonNull (json_person ~> "foo" ~> "bar")
      return (jsonToText x)
    assEq "wrong value returned" "42" val
  where
    Just newJson = decode "{\"foo\": {\"bar\": 42}}" :: Maybe Value
