{-# language ScopedTypeVariables, DataKinds #-}

module RawSqlTest where

import Data.Coerce
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Text as T

import Init
import Database.Persist.SqlBackend
import PersistTestPetType
import PersistentTestModels

specsWith :: Runner SqlBackend m => RunDb SqlBackend m -> Spec
specsWith runDb = describe "rawSql" $ do
    it "2+2" $ runDb $ do
        ret <- rawSql "SELECT 2+2" []
        liftIO $ ret @?= [Single (4::Int)]

    it "?-?" $ runDb $ do
        ret <- rawSql "SELECT ?-?" [PersistInt64 5, PersistInt64 3]
        liftIO $ ret @?= [Single (2::Int)]

    it "NULL" $ runDb $ do
        ret <- rawSql "SELECT NULL" []
        liftIO $ ret @?= [Nothing :: Maybe (Single Int)]

    it "entity" $ runDb $ do
        Entity p1k p1 <- insertEntity $ Person "Mathias"   23 Nothing
        Entity p2k p2 <- insertEntity $ Person "Norbert"   44 Nothing
        Entity p3k _  <- insertEntity $ Person "Cassandra" 19 Nothing
        Entity _   _  <- insertEntity $ Person "Thiago"    19 Nothing
        Entity a1k a1 <- insertEntity $ Pet p1k "Rodolfo" Cat
        Entity a2k a2 <- insertEntity $ Pet p1k "Zeno"    Cat
        Entity a3k a3 <- insertEntity $ Pet p2k "Lhama"   Dog
        Entity _   _  <- insertEntity $ Pet p3k "Abacate" Cat
        escape <- getEscape
        person <- getTableName (error "rawSql Person" :: Person)
        name_   <- getFieldName PersonName
        pet <- getTableName (error "rawSql Pet" :: Pet)
        petName_   <- getFieldName PetName
        let query = T.concat [ "SELECT ??, ?? "
                             , "FROM ", person
                             , ", ", escape "Pet"
                             , " WHERE ", person, ".", escape "age", " >= ? "
                             , "AND ", escape "Pet", ".", escape "ownerId", " = "
                                     , person, ".", escape "id"
                             , " ORDER BY ", person, ".", name_, ", ", pet, ".", petName_
                             ]
        ret <- rawSql query [PersistInt64 20]
        liftIO $ ret @?= [ (Entity p1k p1, Entity a1k a1)
                         , (Entity p1k p1, Entity a2k a2)
                         , (Entity p2k p2, Entity a3k a3) ]
        ret2 <- rawSql query [PersistInt64 20]
        liftIO $ ret2 @?= [ (Just (Entity p1k p1), Just (Entity a1k a1))
                          , (Just (Entity p1k p1), Just (Entity a2k a2))
                          , (Just (Entity p2k p2), Just (Entity a3k a3)) ]
        ret3 <- rawSql query [PersistInt64 20]
        liftIO $ ret3 @?= [ Just (Entity p1k p1, Entity a1k a1)
                          , Just (Entity p1k p1, Entity a2k a2)
                          , Just (Entity p2k p2, Entity a3k a3) ]

    it "order-proof" $ runDb $ do
        let p1 = Person "Zacarias" 93 Nothing
        p1k <- insert p1
        escape <- getEscape
        let query = T.concat [ "SELECT ?? "
                             , "FROM ", escape "Person"
                             ]
        ret1 <- rawSql query []
        ret2 <- rawSql query [] :: MonadIO m => SqlPersistT m [Entity (ReverseFieldOrder Person)]
        liftIO $ ret1 @?= [Entity p1k p1]
        liftIO $ ret2 @?= [Entity (RFOKey $ unPersonKey p1k) (RFO p1)]

    it "permits prefixes" $ runDb $ do
        let r1 = Relationship "Foo" Nothing
        r1k <- insert r1
        let r2 = Relationship "Bar" (Just r1k)
        r2k <- insert r2
        let r3 = Relationship "Lmao" (Just r1k)
        r3k <- insert r3
        let r4 = Relationship "Boring" (Just r2k)
        r4k <- insert r4
        escape <- getEscape
        let query = T.concat
                [ "SELECT ??, ?? "
                , "FROM ", escape "Relationship", " AS parent "
                , "LEFT OUTER JOIN ", escape "Relationship", " AS child "
                , "ON parent.id = child.parent"
                ]

        result :: [(EntityWithPrefix "parent" Relationship, Maybe (EntityWithPrefix "child" Relationship))] <-
            rawSql query []

        liftIO $
            coerce result `shouldMatchList`
                [ (Entity r1k r1, Just (Entity r2k r2))
                , (Entity r1k r1, Just (Entity r3k r3))
                , (Entity r2k r2, Just (Entity r4k r4))
                , (Entity r3k r3, Nothing)
                , (Entity r4k r4, Nothing)
                ]


    it "OUTER JOIN" $ runDb $ do
        let insert' :: (PersistStore backend, PersistEntity val, PersistEntityBackend val ~ BaseBackend backend, MonadIO m)
                    => val -> ReaderT backend m (Key val, val)
            insert' v = insert v >>= \k -> return (k, v)
        (p1k, p1) <- insert' $ Person "Mathias"   23 Nothing
        (p2k, p2) <- insert' $ Person "Norbert"   44 Nothing
        (a1k, a1) <- insert' $ Pet p1k "Rodolfo" Cat
        (a2k, a2) <- insert' $ Pet p1k "Zeno"    Cat
        escape <- getEscape
        let query = T.concat [ "SELECT ??, ?? "
                             , "FROM ", person
                             , "LEFT OUTER JOIN ", pet
                             , " ON ", person, ".", escape "id"
                             , " = ", pet, ".", escape "ownerId"
                             , " ORDER BY ", person, ".", escape "name"
                             , ", ", pet, ".", escape "id" ]
            person = escape "Person"
            pet    = escape "Pet"
        ret <- rawSql query []
        liftIO $ ret @?= [ (Entity p1k p1, Just (Entity a1k a1))
                         , (Entity p1k p1, Just (Entity a2k a2))
                         , (Entity p2k p2, Nothing) ]

    it "handles lower casing" $
        runDb $ do
            C.runConduitRes $ rawQuery "SELECT full_name from lower_case_table WHERE my_id=5" [] C..| CL.sinkNull
            C.runConduitRes $ rawQuery "SELECT something_else from ref_table WHERE id=4" [] C..| CL.sinkNull

    it "commit/rollback" $ do
        caseCommitRollback runDb
        runDb cleanDB

    it "queries with large number of results" $ runDb $ do
        -- max size of a GHC tuple is 62, but Eq instances currently only exist up to 15-tuples
        -- See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3369
        ret <- rawSql "SELECT ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?" $ map PersistInt64 [1..15]
        liftIO $ ret @?= [(Single (1::Int), Single (2::Int), Single (3::Int), Single (4::Int), Single (5::Int), Single (6::Int), Single (7::Int), Single (8::Int), Single (9::Int), Single (10::Int), Single (11::Int), Single (12::Int), Single (13::Int), Single (14::Int), Single (15::Int))]

getEscape :: MonadReader SqlBackend m => m (Text -> Text)
getEscape = getEscapeRawNameFunction

caseCommitRollback :: Runner SqlBackend m => RunDb SqlBackend m -> Assertion
caseCommitRollback runDb = runDb $ do
    let filt :: [Filter Person1]
        filt = []

    let p = Person1 "foo" 0

    insert_ p
    insert_ p
    insert_ p

    c1 <- count filt
    c1 @== 3

    transactionSave
    c2 <- count filt
    c2 @== 3

    insert_ p
    transactionUndo
    c3 <- count filt
    c3 @== 3

    insert_ p
    transactionSave
    insert_ p
    insert_ p
    transactionUndo
    c4 <- count filt
    c4 @== 4