{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- Tests for `Database.Esqueleto.Record`.
module Common.Record (testDeriveEsqueletoRecord) where

import Common.Test.Import hiding (from, on)
import Data.List (sortOn)
import Database.Esqueleto.Experimental
import Database.Esqueleto.Record
       ( DeriveEsqueletoRecordSettings(..)
       , defaultDeriveEsqueletoRecordSettings
       , deriveEsqueletoRecord
       , deriveEsqueletoRecordWith
       )
import GHC.Records

data MyRecord =
    MyRecord
        { myName :: Text
        , myAge :: Maybe Int
        , myUser :: Entity User
        , myAddress :: Maybe (Entity Address)
        }
  deriving (Show, Eq)

$(deriveEsqueletoRecord ''MyRecord)

myRecordQuery :: SqlQuery SqlMyRecord
myRecordQuery = do
  user :& address <- from $
    table @User
      `leftJoin`
      table @Address
      `on` (do \(user :& address) -> user ^. #address ==. address ?. #id)
  pure
    SqlMyRecord
      { myName = castString $ user ^. #name
      , myAge = val $ Just 10
      , myUser = user
      , myAddress = address
      }

data MyNestedRecord = MyNestedRecord
  { myName :: Text
  , myRecord :: MyRecord
  , myMaybeRecord :: Maybe MyRecord
  }
  deriving (Show, Eq)

data MyNestedMaybeRecord = MyNestedMaybeRecord
  {myNestedRecord :: Maybe MyRecord}
  deriving (Show, Eq)

$(deriveEsqueletoRecord ''MyNestedRecord)
$(deriveEsqueletoRecord ''MyNestedMaybeRecord)

myNestedRecordQuery :: SqlQuery SqlMyNestedRecord
myNestedRecordQuery = do
  user :& address <-
    from $
      table @User
        `leftJoin` table @Address
        `on` (do \(user :& address) -> user ^. #address ==. address ?. #id)
  pure
    SqlMyNestedRecord
      { myName = castString $ user ^. #name
      , myRecord =
          SqlMyRecord
            { myName = castString $ user ^. #name
            , myAge = val $ Just 10
            , myUser = user
            , myAddress = address
            }
      , myMaybeRecord =
          SqlMaybeMyRecord
            { myName = castString $ user ^. #name
            , myAge = val $ Just 10
            , myUser = toMaybe user
            , myAddress = address
            }
      }

myNestedMaybeRecordQuery :: SqlQuery SqlMyNestedMaybeRecord
myNestedMaybeRecordQuery = do
  user :& address <-
    from $
      table @User
        `leftJoin` table @Address
        `on` (do \(user :& address) -> user ^. #address ==. address ?. #id)
  pure
    SqlMyNestedMaybeRecord
      {
        myNestedRecord =
          SqlMaybeMyRecord
            { myName = castString $ user ^. #name
            , myAge = val $ Just 10
            , myUser = toMaybe user
            , myAddress = address
            }
      }

data MyModifiedRecord =
    MyModifiedRecord
        { myModifiedName :: Text
        , myModifiedAge :: Maybe Int
        , myModifiedUser :: Entity User
        , myModifiedAddress :: Maybe (Entity Address)
        }
  deriving (Show, Eq)

$(deriveEsqueletoRecordWith (defaultDeriveEsqueletoRecordSettings
    { sqlNameModifier = (++ "Sql")
    , sqlFieldModifier = (++ "Sql")
    })
    ''MyModifiedRecord)

myModifiedRecordQuery :: SqlQuery MyModifiedRecordSql
myModifiedRecordQuery = do
  user :& address <- from $
    table @User
      `leftJoin`
      table @Address
      `on` (do \(user :& address) -> user ^. #address ==. address ?. #id)
  pure
    MyModifiedRecordSql
      { myModifiedNameSql = castString $ user ^. #name
      , myModifiedAgeSql = val $ Just 10
      , myModifiedUserSql = user
      , myModifiedAddressSql = address
      }

mySubselectRecordQuery :: SqlQuery (SqlExpr (Maybe (Entity Address)))
mySubselectRecordQuery = do
  _ :& record <- from $
    table @User
      `leftJoin`
      myRecordQuery
      `on` (do \(user :& record) -> just (user ^. #id) ==. getField @"myUser" record ?. #id)
  pure $ getField @"myAddress" record

testDeriveEsqueletoRecord :: SpecDb
testDeriveEsqueletoRecord = describe "deriveEsqueletoRecord" $ do
    let setup :: MonadIO m => SqlPersistT m ()
        setup = do
          _ <- insert $ User { userAddress = Nothing, userName = "Rebecca" }
          addr <- insert $ Address { addressAddress = "30-50 Feral Hogs Rd" }
          _ <- insert $ User { userAddress = Just addr, userName = "Some Guy" }
          pure ()

    itDb "can select records" $ do
        setup
        records <- select myRecordQuery
        let sortedRecords = sortOn (\MyRecord {myName} -> myName) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case MyRecord { myName = "Rebecca"
                          , myAge = Just 10
                          , myUser = Entity _ User { userAddress  = Nothing
                                                   , userName = "Rebecca"
                                                   }
                          , myAddress = Nothing
                          } -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case MyRecord { myName = "Some Guy"
                          , myAge = Just 10
                          , myUser = Entity _ User { userAddress  = Just addr1
                                                   , userName = "Some Guy"
                                                   }
                          , myAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"})
                          } -> addr1 == addr2 -- The keys should match.
                 _ -> False)

    itDb "can select nested records" $ do
        setup
        records <- select myNestedRecordQuery
        let sortedRecords = sortOn (\MyNestedRecord {myName} -> myName) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case MyNestedRecord
                   { myName = "Rebecca"
                   , myRecord =
                       MyRecord { myName = "Rebecca"
                                , myAge = Just 10
                                , myUser = Entity _ User { userAddress  = Nothing
                                                         , userName = "Rebecca"
                                                         }
                                , myAddress = Nothing
                                }
                   } -> True
                 _ -> False)

        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case MyNestedRecord
                   { myName = "Some Guy"
                   , myRecord =
                       MyRecord { myName = "Some Guy"
                                , myAge = Just 10
                                , myUser = Entity _ User { userAddress  = Just addr1
                                                         , userName = "Some Guy"
                                                         }
                                , myAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"})
                                }
                   } -> addr1 == addr2 -- The keys should match.
                 _ -> False)

    itDb "can select nested maybe records" $ do
        setup
        records <- select myNestedMaybeRecordQuery
        let sortedRecords = sortOn (\MyNestedMaybeRecord {myNestedRecord} -> case myNestedRecord of
                                       Just r -> getField @"myName" r
                                       Nothing -> "No name"
                                    ) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case MyNestedMaybeRecord
                   {
                    myNestedRecord = Just
                       MyRecord { myName = "Rebecca"
                                , myAge = Just 10
                                , myUser = Entity _ User { userAddress  = Nothing
                                                         , userName = "Rebecca"
                                                         }
                                , myAddress = Nothing
                                }
                   } -> True
                 _ -> False)

        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case MyNestedMaybeRecord
                   {
                    myNestedRecord = Just
                       MyRecord { myName = "Some Guy"
                                , myAge = Just 10
                                , myUser = Entity _ User { userAddress  = Just addr1
                                                         , userName = "Some Guy"
                                                         }
                                , myAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"})
                                }
                   } -> addr1 == addr2 -- The keys should match.
                 _ -> False)

    itDb "can select nested nothing records" $ do
        setup
        records <- select $ do
          user :& address <-
            from $ table @User `leftJoin` table @Address `on` (do \(_ :& _) -> val False)
          pure
            SqlMyNestedMaybeRecord
            {
              myNestedRecord =
                SqlMaybeMyRecord
                  { myName = val Nothing
                  , myAge = val Nothing
                  , myUser = toMaybe user
                  , myAddress = address
                  }
            }
        liftIO $ records `shouldBe`
          [MyNestedMaybeRecord { myNestedRecord = Nothing }, MyNestedMaybeRecord { myNestedRecord = Nothing}]

    itDb "can left join on nested maybed records" $ do
        setup
        records <- select $ do
          from
            ( table @User
                `leftJoin` myNestedMaybeRecordQuery
                `on` (do \(user :& record) -> just (user ^. #id) ==. getField @"myUser" (getField @"myNestedRecord" record) ?. #id)
            )
        let sortedRecords = sortOn (\(Entity _ user :& _) -> getField @"userName" user) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case (_ :& Just (MyNestedMaybeRecord
                              {
                                myNestedRecord = Just
                                  MyRecord { myName = "Rebecca",
                                             myAddress = Nothing
                                           }
                              }
                            )) -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case ( _ :& Just (MyNestedMaybeRecord
                               { myNestedRecord = Just
                                   MyRecord { myName = "Some Guy"
                                            , myAddress = (Just (Entity _ Address {addressAddress = "30-50 Feral Hogs Rd"}))
                                            }
                               }
                             )) -> True
                 _ -> False)

    itDb "can left join on nothing nested records" $ do
        setup
        records <- select $ do
          from (table @User `leftJoin` myNestedMaybeRecordQuery `on` (do \(_ :& _) -> val False))
        let sortedRecords = sortOn (\(Entity _ user :& _) -> getField @"userName" user) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case (_ :& Nothing) -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case (_ :& Nothing) -> True
                 _ -> False)

    itDb "can be used in a CTE" $ do
        setup
        records <- select $ do
            recordCTE <- with myRecordQuery
            record <- from recordCTE
            pure record
        let sortedRecords = sortOn (\MyRecord {myName} -> myName) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case MyRecord { myName = "Rebecca"
                          , myAge = Just 10
                          , myUser = Entity _ User { userAddress  = Nothing
                                                   , userName = "Rebecca"
                                                   }
                          , myAddress = Nothing
                          } -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case MyRecord { myName = "Some Guy"
                          , myAge = Just 10
                          , myUser = Entity _ User { userAddress  = Just addr1
                                                   , userName = "Some Guy"
                                                   }
                          , myAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"})
                          } -> addr1 == addr2 -- The keys should match.
                 _ -> False)

    itDb "can select user-modified records" $ do
        setup
        records <- select myModifiedRecordQuery
        let sortedRecords = sortOn (\MyModifiedRecord {myModifiedName} -> myModifiedName) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case MyModifiedRecord
                  { myModifiedName = "Rebecca"
                  , myModifiedAge = Just 10
                  , myModifiedUser = Entity _ User { userAddress  = Nothing
                                           , userName = "Rebecca"
                                           }
                  , myModifiedAddress = Nothing
                  } -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case MyModifiedRecord
                    { myModifiedName = "Some Guy"
                    , myModifiedAge = Just 10
                    , myModifiedUser = Entity _ User { userAddress  = Just addr1
                                             , userName = "Some Guy"
                                             }
                    , myModifiedAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"})
                    } -> addr1 == addr2 -- The keys should match.
                 _ -> False)

    itDb "can left join on records" $ do
        setup
        records <- select $ do
          from
            ( table @User
                `leftJoin` myRecordQuery `on` (do \(user :& record) -> just (user ^. #id) ==. getField @"myUser" record ?. #id)
            )
        let sortedRecords = sortOn (\(Entity _ user :& _) -> getField @"userName" user) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case (_ :& Just (MyRecord {myName = "Rebecca", myAddress = Nothing})) -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case ( _ :& Just ( MyRecord { myName = "Some Guy"
                                        , myAddress = (Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"}))
                                        }
                              )) -> True
                 _ -> False)

    itDb "can handle joins on records with Nothing" $ do
        setup
        records <- select $ do
          from
            ( table @User
                `leftJoin` myRecordQuery `on` (do \(user :& record) -> user ^. #address ==. getField @"myAddress" record ?. #id)
            )
        let sortedRecords = sortOn (\(Entity _ user :& _) -> getField @"userName" user) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case (_ :& Nothing) -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case ( _ :& Just ( MyRecord { myName = "Some Guy"
                                        , myAddress = (Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"}))
                                        }
                              )) -> True
                 _ -> False)

    itDb "can left join on nested records" $ do
        setup
        records <- select $ do
          from
            ( table @User
                `leftJoin` myNestedRecordQuery
                `on` (do \(user :& record) -> just (user ^. #id) ==. getField @"myUser" (getField @"myRecord" record) ?. #id)
            )
        let sortedRecords = sortOn (\(Entity _ user :& _) -> getField @"userName" user) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case (_ :& Just (MyNestedRecord {myRecord = MyRecord {myName = "Rebecca", myAddress = Nothing}})) -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case ( _ :& Just ( MyNestedRecord { myRecord = MyRecord { myName = "Some Guy"
                                                                    , myAddress = (Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"}))
                                                                    }
                                              })) -> True
                 _ -> False)

    itDb "can handle multiple left joins on the same record" $ do
        setup
        records <- select $ do
          from
            ( table @User
                `leftJoin` myNestedRecordQuery
                `on` (do \(user :& record) -> just (user ^. #id) ==. getField @"myUser" (getField @"myRecord" record) ?. #id)
                `leftJoin` myNestedRecordQuery
                `on` (do \(user :& record1 :& record2) -> getField @"myUser" (getField @"myRecord" record1) ?. #id !=. getField @"myUser" (getField @"myRecord" record2) ?. #id)
            )
        let sortedRecords = sortOn (\(Entity _ user :& _ :& _) -> getField @"userName" user) records
        liftIO $ sortedRecords !! 0
          `shouldSatisfy`
          (\case ( _ :& _ :& Just ( MyNestedRecord { myRecord = MyRecord { myName = "Some Guy"
                                                                    , myAddress = (Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"}))
                                                                    }
                                              })) -> True
                 _ -> False)
        liftIO $ sortedRecords !! 1
          `shouldSatisfy`
          (\case (_ :& _ :& Just (MyNestedRecord {myRecord = MyRecord {myName = "Rebecca", myAddress = Nothing}})) -> True
                 _ -> False)