{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Basic.Example (module Data.Basic.Example) where

import Internal.Interlude hiding (filter)

import Data.Basic
import Language.Haskell.TH hiding (location)


import Unsafe.Coerce

data User = User { _userId   :: {-# UNPACK #-} !Key
                 , _userName :: {-# UNPACK #-} !Text
                 , _userLocation :: Point } deriving (Eq, Read, Show)

makeLenses ''User

instance Table User where
    type TableName User = "blog_user"
    type TableFields User = ["id", "name", "location"]
    type TableConstraints User = '[ 'Unique "blog_user_pkey"]
    type TablePrimaryKey User = 'Just "blog_user_pkey"
    type TableRequiredFields User = ['Required "id", 'Required "name"]
    newEntity = Entity (User (unsafeCoerce ()) (unsafeCoerce ()) (Point 0 0))

instance UniqueConstraint "blog_user_pkey" where
    type UniqueTable "blog_user_pkey" = User
    type UniqueFields "blog_user_pkey" = '["id"]

instance PrimaryKeyConstraint "blog_user_pkey"

instance TableField User "id" where
    type TableFieldType User "id" = Key
    tableFieldLens = userId

instance TableField User "name" where
    type TableFieldType User "name" = Text
    tableFieldLens = userName

instance TableField User "location" where
    type TableFieldType User "location" = Point
    tableFieldLens = userLocation

instance FromRow User where
    fromRow = User <$> field <*> field <*> field

data Post = Post { _postId     :: Key
                 , _postName   :: Text
                 , _postUserId :: Key } deriving (Eq, Ord, Read, Show)

makeLenses ''Post

instance Table Post where
    type TableName Post = "blog_post"
    type TableFields Post = ["id", "name", "author"]
    type TableConstraints Post = '[ 'ForeignKey "blog_post_author_fkey"]
    type TablePrimaryKey Post = 'Just "blog_post_pkey"
    type TableRequiredFields Post = ['Required "id", 'Required "name", 'Required "author"]
    newEntity = Entity (Post (unsafeCoerce ()) (unsafeCoerce ()) (unsafeCoerce ()))

instance UniqueConstraint "blog_post_pkey" where
    type UniqueTable "blog_post_pkey" = Post
    type UniqueFields "blog_post_pkey" = '["id"]

instance PrimaryKeyConstraint "blog_post_pkey"

instance FromRow Post where
    fromRow = Post <$> field <*> field <*> field

instance TableField Post "id" where
    type TableFieldType Post "id" = Key
    tableFieldLens = postId

instance TableField Post "name" where
    type TableFieldType Post "name" = Text
    tableFieldLens = postName

instance TableField Post "author" where
    type TableFieldType Post "author" = Key
    tableFieldLens = postUserId

instance ForeignKeyConstraint "blog_post_author_fkey" where
    type ForeignKeyFrom "blog_post_author_fkey" = Post
    type ForeignKeyFromFields "blog_post_author_fkey" = '["author"]
    type ForeignKeyTo "blog_post_author_fkey" = User
    type ForeignKeyToFields "blog_post_author_fkey" = '["id"]

allUsers :: AllRows User res => res
allUsers = allRows @"blog_user"

allPosts :: AllRows Post res => res
allPosts = allRows @"blog_post"

newUser :: Entity ('Fresh ['Required "id", 'Required "name", 'Required "location"]) User
newUser = Entity (User 0 "" (Point 0 0))

newPost :: Entity ('Fresh ['Required "id", 'Required "name", 'Required "author"]) Post
newPost = Entity (Post 0 "" 1)

posts :: VirtualTable "blog_post_author_fkey" res
      => Getter' (Entity ('FromDb c) (ForeignKeyTo "blog_post_author_fkey")) res
posts = virtualTableLens @"blog_post_author_fkey"

id :: FieldOpticProxy (Proxy "id" -> o) => o
id = fieldOptic @"id"

name :: FieldOpticProxy (Proxy "name" -> o) => o
name = fieldOptic @"name"

location :: FieldOpticProxy (Proxy "location" -> o) => o
location = fieldOptic @"location"

authorId :: FieldOpticProxy (Proxy "author" -> o) => o
authorId = fieldOptic @"author"

author :: ForeignKeyLensProxy (Proxy "blog_post_author_fkey" -> o) => o
author = foreignKeyLens @"blog_post_author_fkey"

test1 :: (MonadIO m, MonadEffect Basic m) => m ()
test1 = do
    void $ ddelete allPosts
    void $ ddelete allUsers
    let user = newUser & name .~ "Luka"
                       & id .~ 1
                       & location .~ Point 5 6
    user' <- insert user
    let post = newPost & id .~ 1
                       & name .~ "New post"
                       & author .~ user'
    post' <- insert post
    void $ dfilter (\u -> (u ^. id) `delem` [1, 3, 4]) allUsers
    void $ dfilter (\u -> u ^. id <. (2 :: Key)) allUsers

    auth <- post' ^. author
    putText (toS $ encode auth)
    void $ save (auth & name .~ "Luka H")

    let user2 = newUser & name .~ "Ivan"
                        & id .~ 2
                        & location .~ Point 6 7
    void $ insert user2

    us <- dtake 1 $ dsortOn (\u -> Down (u ^. id)) allUsers
    putText (toS $ encode us)

    void $ dupdate (\u' -> u' & location .~ Point 7 8) allUsers

    usersPosts <- allUsers `djoin` allPosts
    putText (toS $ encode usersPosts)

    users <- dfilter (\u -> (u ^. name) `ilike` "%uka%") allUsers
    putText (toS $ encode users)


    -- Folding/grouping test
    void $ ddelete allPosts
    void $ ddelete allUsers
    void $ insert $
        newUser
            & name .~ "A"
            & id .~ 1
            & location .~ Point 0 0

    void $ insert $
        newUser
            & name .~ "A"
            & id .~ 2
            & location .~ Point 0 0

    void $ insert $
        newUser
            & name .~ "B"
            & id .~ 3
            & location .~ Point 0 0

    void $ insert $
        newUser
            & name .~ "B"
            & id .~ 4
            & location .~ Point 0 0

    print =<< dfoldMap (\u -> (Min (u ^. id), Max (u ^. id))) allUsers
    -- putText . toS . encode =<< dtake 1 (dmap (^. name) allUsers)
    putText . toS . encode =<< dmap fst (allUsers `djoin` allUsers)
    print =<< dmap (^. location) (dsortOn (view name) allUsers)
    allUsers
        & dgroupOn (view name)
        & dmap (\(_, g) ->
            (dfoldMap ((,) <$> Min . view id <*> Max . view id) g)
            )
        & (>>= print)
    allUsers
        & dgroupOn (view name)
        & dfoldMapInner ((,) <$> Min . view id <*> Max . view id)
        & (>>= print)

    -- Comparing
    print $ (newUser & name .~ "abc" & id .~ 1) > (newUser & name .~ "abd" & id .~ 0)
    print $ (newUser & location .~ Point 0 0) == (newUser & location .~ Point 0 1)

    void $ ddelete allPosts
    void $ ddelete allUsers
    l <- insert $ newUser
        & name .~ "Luka"
        & id .~ 0
        & location .~ Point 0 0
    void $ insert $
        newPost
            & id .~ 10
            & name .~ "Post 1\"\\"
            & author .~ l
    void $ insert $
        newPost
            & id .~ 11
            & name .~ ""
            & author .~ l

    pairs' <- allUsers `djoin` allPosts
        & dfilter (\(u, p) -> u ^. id ==. p ^. authorId)
        & dgroupOn fst
        & dfoldMapInner (List . snd)
    print pairs'

    -- print $ (newUser & name .~ "abc") > (newUser & location .~ Point 0 0)


test :: IO ()
test = do
    conn <- connectPostgreSQL "host=localhost port=5432 user=postgres dbname=postgres password=admin connect_timeout=10"
    test1
        & handleBasicPsqlWithLogging conn
        & prettyPrintSummary 1000
        & throwBasicToIO
        -- & handleSignal (\(b :: BasicException) -> do
        --     print b
        --     (q :: Query) <- readLn
        --     return (Resume q)
        --     )

-- Two very useful functions.
-- And these are just good for printing out code.

putQ :: Show a => Q a -> IO ()
putQ xQ = do x <- runQ xQ
             print x

putQLn :: Show a => Q a -> IO ()
putQLn xQ = do putQ xQ
               putText ""