haskell-persistent/persistent-postgresql/test/JSONTest.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- FIXME

module JSONTest where

import Control.Monad.IO.Class (MonadIO)
import Data.Aeson
import qualified Data.Vector as V (fromList)
import Test.HUnit (assertBool)
import Test.Hspec.Expectations ()

import Database.Persist
import Database.Persist.Postgresql.JSON

import PgInit

share [mkPersist persistSettings,  mkMigrate "jsonTestMigrate"] [persistLowerCase|
  TestValue
    json Value
    deriving Show
|]

cleanDB :: (BaseBackend backend ~ SqlBackend, PersistQueryWrite backend, MonadIO m) => ReaderT backend m ()
cleanDB = deleteWhere ([] :: [Filter TestValue])

emptyArr :: Value
emptyArr = toJSON ([] :: [Value])

insert' :: (MonadIO m, PersistStoreWrite backend, BaseBackend backend ~ SqlBackend)
        => Value -> ReaderT backend m (Key TestValue)
insert' = insert . TestValue

(=@=) :: MonadIO m => String -> Bool -> m ()
s =@= b = liftIO $ assertBool s b

matchKeys :: (Show record, Show (Key record), MonadIO m, Eq (Key record))
          => String -> [Key record] -> [Entity record] -> m ()
matchKeys s ys xs = do
    msg1 =@= (xLen == yLen)
    forM_ ys $ \y -> msg2 y =@= (y `elem` ks)
  where ks = entityKey <$> xs
        xLen = length xs
        yLen = length ys
        msg1 = mconcat
            [ s, "\nexpected: ", show yLen
            , "\n but got: ", show xLen
            , "\n[xs: ", show xs
            , ", ys: ", show ys, "]"
            ]
        msg2 y = mconcat
            [ s, ": "
            , "key \"", show y
            , "\" not in result:\n  ", show ks
            ]

specs :: Spec
specs = describe "postgresql's JSON operators behave" $ do

  it "migrate, clean table, insert values and check queries" $ asIO $ runConn $ do
      runMigration jsonTestMigrate
      cleanDB

      liftIO $ putStrLn "\n- - - - -  Inserting JSON values  - - - - -\n"

      nullK <- insert' Null

      boolTK <- insert' $ Bool True
      boolFK <- insert' $ toJSON False

      num0K <- insert' $ Number 0
      num1K <- insert' $ Number 1
      numBigK <- insert' $ toJSON (1234567890 :: Int)
      numFloatK <- insert' $ Number 0.0
      numSmallK <- insert' $ Number 0.0000000000000000123
      numFloat2K <- insert' $ Number 1.5
      -- numBigFloatK will turn into 9876543210.123457 because JSON
      numBigFloatK <- insert' $ toJSON (9876543210.123456789 :: Double)

      strNullK <- insert' $ String ""
      strObjK <- insert' $ String "{}"
      strArrK <- insert' $ String "[]"
      strAK <- insert' $ String "a"
      strTestK <- insert' $ toJSON ("testing" :: Text)
      str2K <- insert' $ String "2"
      strFloatK <- insert' $ String "0.45876"

      arrNullK <- insert' $ Array $ V.fromList []
      arrListK <- insert' $ toJSON ([emptyArr,emptyArr,toJSON [emptyArr,emptyArr]])
      arrList2K <- insert' $ toJSON [emptyArr,toJSON [Number 3,Bool False],toJSON [emptyArr,toJSON [Object mempty]]]
      arrFilledK <- insert' $ toJSON [Null, Number 4, String "b", Object mempty, emptyArr, object [ "test" .= [Null], "test2" .= String "yes"]]

      objNullK <- insert' $ Object mempty
      objTestK <- insert' $ object ["test" .= Null, "test1" .= String "no"]
      objDeepK <- insert' $ object ["c" .= Number 24.986, "foo" .= object ["deep1" .= Bool True]]

----------------------------------------------------------------------------------------

      liftIO $ putStrLn "\n- - - - -  Starting @> tests  - - - - -\n"

      -- An empty Object matches any object
      selectList [TestValueJson @>. Object mempty] []
        >>= matchKeys "1" [objNullK,objTestK,objDeepK]

      -- {"test":null,"test1":"no"} @> {"test":null} == True
      selectList [TestValueJson @>. object ["test" .= Null]] []
        >>= matchKeys "2" [objTestK]

      -- {"c":24.986,"foo":{"deep1":true"}} @> {"foo":{}} == True
      selectList [TestValueJson @>. object ["foo" .= object []]] []
        >>= matchKeys "3" [objDeepK]

      -- {"c":24.986,"foo":{"deep1":true"}} @> {"foo":"nope"} == False
      selectList [TestValueJson @>. object ["foo" .= String "nope"]] []
        >>= matchKeys "4" []

      -- {"c":24.986,"foo":{"deep1":true"}} @> {"foo":{"deep1":true}} == True
      selectList [TestValueJson @>. (object ["foo" .= object ["deep1" .= True]])] []
        >>= matchKeys "5" [objDeepK]

      -- {"c":24.986,"foo":{"deep1":true"}} @> {"deep1":true} == False
      selectList [TestValueJson @>. object ["deep1" .= True]] []
        >>= matchKeys "6" []

      -- An empty Array matches any array
      selectList [TestValueJson @>. emptyArr] []
        >>= matchKeys "7" [arrNullK,arrListK,arrList2K,arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [4] == True
      selectList [TestValueJson @>. toJSON [4 :: Int]] []
        >>= matchKeys "8" [arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [null,"b"] == True
      selectList [TestValueJson @>. toJSON [Null, String "b"]] []
        >>= matchKeys "9" [arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [null,"d"] == False
      selectList [TestValueJson @>. toJSON [emptyArr, String "d"]] []
        >>= matchKeys "10" []

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [[],"b",{"test":[null],"test2":"yes"},4,null,{}] == True
      selectList [TestValueJson @>. toJSON [emptyArr, String "b", object [ "test" .= [Null], "test2" .= String "yes"], Number 4, Null, Object mempty]] []
        >>= matchKeys "11" [arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [null,4,"b",{},[],{"test":[null],"test2":"yes"},false] == False
      selectList [TestValueJson @>. toJSON [Null, Number 4, String "b", Object mempty, emptyArr, object [ "test" .= [Null], "test2" .= String "yes"], Bool False]] []
        >>= matchKeys "12" []

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [{}] == True
      selectList [TestValueJson @>. toJSON [Object mempty]] []
        >>= matchKeys "13" [arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [{"test":[]}] == True
      selectList [TestValueJson @>. toJSON [object ["test" .= emptyArr]]] []
        >>= matchKeys "14" [arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [{"test1":[null]}]  == False
      selectList [TestValueJson @>. toJSON [object ["test1" .= [Null]]]] []
        >>= matchKeys "15" []

      -- [[],[],[[],[]]]                                  @> [[]] == True
      -- [[],[3,false],[[],[{}]]]                         @> [[]] == True
      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> [[]] == True
      selectList [TestValueJson @>. toJSON [emptyArr]] []
        >>= matchKeys "16" [arrListK,arrList2K,arrFilledK]

      -- [[],[3,false],[[],[{}]]] @> [[3]] == True
      selectList [TestValueJson @>. toJSON [[3 :: Int]]] []
        >>= matchKeys "17" [arrList2K]

      -- [[],[3,false],[[],[{}]]] @> [[true,3]] == False
      selectList [TestValueJson @>. toJSON [[Bool True, Number 3]]] []
        >>= matchKeys "18" []

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> 4 == True
      selectList [TestValueJson @>. Number 4] []
        >>= matchKeys "19" [arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> 4 == True
      selectList [TestValueJson @>. Number 99] []
        >>= matchKeys "20" []

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> "b" == True
      selectList [TestValueJson @>. String "b"] []
        >>= matchKeys "21" [arrFilledK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> "{}" == False
      selectList [TestValueJson @>. String "{}"] []
        >>= matchKeys "22" [strObjK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] @> {"test":[null],"test2":"yes"} == False
      selectList [TestValueJson @>. object [ "test" .= [Null], "test2" .= String "yes"]] []
        >>= matchKeys "23" []

      -- "testing" @> "testing" == True
      selectList [TestValueJson @>. String "testing"] []
        >>= matchKeys "24" [strTestK]

      -- "testing" @> "Testing" == False
      selectList [TestValueJson @>. String "Testing"] []
        >>= matchKeys "25" []

      -- "testing" @> "test" == False
      selectList [TestValueJson @>. String "test"] []
        >>= matchKeys "26" []

      -- "testing" @> {"testing":1} == False
      selectList [TestValueJson @>. object ["testing" .= Number 1]] []
        >>= matchKeys "27" []

      -- 1 @> 1 == True
      selectList [TestValueJson @>. toJSON (1 :: Int)] []
        >>= matchKeys "28" [num1K]

      -- 0 @> 0.0 == True
      -- 0.0 @> 0.0 == True
      selectList [TestValueJson @>. toJSON (0.0 :: Double)] []
        >>= matchKeys "29" [num0K,numFloatK]

      -- 1234567890 @> 123456789 == False
      selectList [TestValueJson @>. toJSON (123456789 :: Int)] []
        >>= matchKeys "30" []

      -- 1234567890 @> 234567890 == False
      selectList [TestValueJson @>. toJSON (234567890 :: Int)] []
        >>= matchKeys "31" []

      -- 1 @> "1" == False
      selectList [TestValueJson @>. String "1"] []
        >>= matchKeys "32" []

      -- 1234567890 @> [1,2,3,4,5,6,7,8,9,0] == False
      selectList [TestValueJson @>. toJSON ([1,2,3,4,5,6,7,8,9,0] :: [Int])] []
        >>= matchKeys "33" []

      -- true @> true == True
      -- false @> true == False
      selectList [TestValueJson @>. toJSON True] []
        >>= matchKeys "34" [boolTK]

      -- false @> false == True
      -- true @> false == False
      selectList [TestValueJson @>. Bool False] []
        >>= matchKeys "35" [boolFK]

      -- true @> "true" == False
      selectList [TestValueJson @>. String "true"] []
        >>= matchKeys "36" []

      -- null @> null == True
      selectList [TestValueJson @>. Null] []
        >>= matchKeys "37" [nullK,arrFilledK]

      -- null @> "null" == False
      selectList [TestValueJson @>. String "null"] []
        >>= matchKeys "38" []

----------------------------------------------------------------------------------------

      liftIO $ putStrLn "\n- - - - -  Starting <@ tests  - - - - -\n"

      -- {}                         <@ {"test":null,"test1":"no","blabla":[]} == True
      -- {"test":null,"test1":"no"} <@ {"test":null,"test1":"no","blabla":[]} == True
      selectList [TestValueJson <@. object ["test" .= Null, "test1" .= String "no", "blabla" .= emptyArr]] []
        >>= matchKeys "39" [objNullK,objTestK]

      -- []                                               <@ [null,4,"b",{},[],{"test":[null],"test2":"yes"},false] == True
      -- null                                             <@ [null,4,"b",{},[],{"test":[null],"test2":"yes"},false] == True
      -- false                                            <@ [null,4,"b",{},[],{"test":[null],"test2":"yes"},false] == True
      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] <@ [null,4,"b",{},[],{"test":[null],"test2":"yes"},false] == True
      selectList [TestValueJson <@. toJSON [Null, Number 4, String "b", Object mempty, emptyArr, object [ "test" .= [Null], "test2" .= String "yes"], Bool False]] []
        >>= matchKeys "40" [arrNullK,arrFilledK,boolFK,nullK]

      -- "a" <@ "a" == True
      selectList [TestValueJson <@. String "a"] []
        >>= matchKeys "41" [strAK]


      -- 9876543210.123457 <@ 9876543210.123457 == False
      selectList [TestValueJson <@. Number 9876543210.123457] []
        >>= matchKeys "42" [numBigFloatK]

      -- 9876543210.123457 <@ 9876543210.123456789 == False
      selectList [TestValueJson <@. Number 9876543210.123456789] []
        >>= matchKeys "43" []

      -- null <@ null == True
      selectList [TestValueJson <@. Null] []
        >>= matchKeys "44" [nullK]

----------------------------------------------------------------------------------------

      liftIO $ putStrLn "\n- - - - -  Starting ? tests  - - - - -\n"

      arrList3K <- insert' $ toJSON [toJSON [String "a"], Number 1]
      arrList4K <- insert' $ toJSON [String "a", String "b", String "c", String "d"]
      objEmptyK <- insert' $ object ["" .= Number 9001]
      objFullK  <- insert' $ object ["a" .= Number 1, "b" .= Number 2, "c" .= Number 3, "d" .= Number 4]

      -- {"test":null,"test1":"no"}                       ? "test" == True
      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] ? "test" == False
      selectList [TestValueJson ?. "test"] []
        >>= matchKeys "45" [objTestK]

      -- {"c":24.986,"foo":{"deep1":true"}} ? "deep1" == False
      selectList [TestValueJson ?. "deep1"] []
        >>= matchKeys "46" []

      -- "{}" ? "{}" == True
      -- {}   ? "{}" == False
      selectList [TestValueJson ?. "{}"] []
        >>= matchKeys "47" [strObjK]

      -- {}        ? "" == False
      -- ""        ? "" == True
      -- {"":9001} ? "" == True
      selectList [TestValueJson ?. ""] []
        >>= matchKeys "48" [strNullK,objEmptyK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] ? "b" == True
      selectList [TestValueJson ?. "b"] []
        >>= matchKeys "49" [arrFilledK,arrList4K,objFullK]

      -- [["a"]]                   ? "a" == False
      -- "a"                       ? "a" == True
      -- ["a","b","c","d"]         ? "a" == True
      -- {"a":1,"b":2,"c":3,"d":4} ? "a" == True
      selectList [TestValueJson ?. "a"] []
        >>= matchKeys "50" [strAK,arrList4K,objFullK]

      -- "[]" ? "[]" == True
      -- []   ? "[]" == False
      selectList [TestValueJson ?. "[]"] []
        >>= matchKeys "51" [strArrK]

      -- null ? "null" == False
      selectList [TestValueJson ?. "null"] []
        >>= matchKeys "52" []

      -- true ? "true" == False
      selectList [TestValueJson ?. "true"] []
        >>= matchKeys "53" []

----------------------------------------------------------------------------------------

      liftIO $ putStrLn "\n- - - - -  Starting ?| tests  - - - - -\n"

      -- "a"                                              ?| ["a","b","c"] == True
      -- [["a"],1]                                        ?| ["a","b","c"] == False
      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] ?| ["a","b","c"] == True
      -- ["a","b","c","d"]                                ?| ["a","b","c"] == True
      -- {"a":1,"b":2,"c":3,"d":4}                        ?| ["a","b","c"] == True
      selectList [TestValueJson ?|. ["a","b","c"]] []
        >>= matchKeys "54" [strAK,arrFilledK,objDeepK,arrList4K,objFullK]

      -- "{}"  ?| ["{}"] == True
      -- {}    ?| ["{}"] == False
      selectList [TestValueJson ?|. ["{}"]] []
        >>= matchKeys "55" [strObjK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] ?| ["test"] == False
      -- "testing"                                        ?| ["test"] == False
      -- {"test":null,"test1":"no"}                       ?| ["test"] == True
      selectList [TestValueJson ?|. ["test"]] []
        >>= matchKeys "56" [objTestK]

      -- {"c":24.986,"foo":{"deep1":true"}} ?| ["deep1"] == False
      selectList [TestValueJson ?|. ["deep1"]] []
        >>= matchKeys "57" []

      -- ANYTHING ?| [] == False
      selectList [TestValueJson ?|. []] []
        >>= matchKeys "58" []

      -- true ?| ["true","null","1"] == False
      -- null ?| ["true","null","1"] == False
      -- 1    ?| ["true","null","1"] == False
      selectList [TestValueJson ?|. ["true","null","1"]] []
        >>= matchKeys "59" []

      -- []   ?| ["[]"] == False
      -- "[]" ?| ["[]"] == True
      selectList [TestValueJson ?|. ["[]"]] []
        >>= matchKeys "60" [strArrK]

----------------------------------------------------------------------------------------

      liftIO $ putStrLn "\n- - - - -  Starting ?& tests  - - - - -\n"

      -- ANYTHING ?& [] == True
      selectList [TestValueJson ?&. []] []
        >>= matchKeys "61" [ nullK
                           , boolTK, boolFK
                           , num0K, num1K, numBigK, numFloatK, numSmallK, numFloat2K, numBigFloatK
                           , strNullK, strObjK, strArrK, strAK, strTestK, str2K, strFloatK
                           , arrNullK, arrListK, arrList2K, arrFilledK
                           , objNullK, objTestK, objDeepK

                           , arrList3K, arrList4K
                           , objEmptyK, objFullK
                           ]

      -- "a"                       ?& ["a"] == True
      -- [["a"],1]                 ?& ["a"] == False
      -- ["a","b","c","d"]         ?& ["a"] == True
      -- {"a":1,"b":2,"c":3,"d":4} ?& ["a"] == True
      selectList [TestValueJson ?&. ["a"]] []
        >>= matchKeys "62" [strAK,arrList4K,objFullK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] ?& ["b","c"] == False
      -- {"c":24.986,"foo":{"deep1":true"}}               ?& ["b","c"] == False
      -- ["a","b","c","d"]                                ?& ["b","c"] == True
      -- {"a":1,"b":2,"c":3,"d":4}                        ?& ["b","c"] == True
      selectList [TestValueJson ?&. ["b","c"]] []
        >>= matchKeys "63" [arrList4K,objFullK]

      -- {}   ?& ["{}"] == False
      -- "{}" ?& ["{}"] == True
      selectList [TestValueJson ?&. ["{}"]] []
        >>= matchKeys "64" [strObjK]

      -- [null,4,"b",{},[],{"test":[null],"test2":"yes"}] ?& ["test"] == False
      -- "testing"                                        ?& ["test"] == False
      -- {"test":null,"test1":"no"}                       ?& ["test"] == True
      selectList [TestValueJson ?&. ["test"]] []
        >>= matchKeys "65" [objTestK]

      -- {"c":24.986,"foo":{"deep1":true"}} ?& ["deep1"] == False
      selectList [TestValueJson ?&. ["deep1"]] []
        >>= matchKeys "66" []

      -- "a"                       ?& ["a","e"] == False
      -- ["a","b","c","d"]         ?& ["a","e"] == False
      -- {"a":1,"b":2,"c":3,"d":4} ?& ["a","e"] == False
      selectList [TestValueJson ?&. ["a","e"]] []
        >>= matchKeys "67" []

      -- []   ?& ["[]"] == False
      -- "[]" ?& ["[]"] == True
      selectList [TestValueJson ?&. ["[]"]] []
        >>= matchKeys "68" [strArrK]

      -- THIS WILL FAIL IF THE IMPLEMENTATION USES
      -- @ '{null}' @
      -- INSTEAD OF
      -- @ ARRAY['null'] @
      -- null ?& ["null"] == False
      selectList [TestValueJson ?&. ["null"]] []
        >>= matchKeys "69" []

      -- [["a"],1] ?& ["1"] == False
      -- "1"       ?& ["1"] == True
      selectList [TestValueJson ?&. ["1"]] []
        >>= matchKeys "70" []

      -- {}        ?& [""] == False
      -- []        ?& [""] == False
      -- ""        ?& [""] == True
      -- {"":9001} ?& [""] == True
      selectList [TestValueJson ?&. [""]] []
        >>= matchKeys "71" [strNullK,objEmptyK]