Compile error

BeamTutorial.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-#  LANGUAGE ImpredicativeTypes #-}
module BeamTutorial where

import Database.Beam
import Database.Beam.Postgres (connect, defaultConnectInfo, runBeamPostgresDebug, PgSelectSyntax)

import Data.Text (Text)

data UserT f = User
    { _userEmail     :: Columnar f Text
    , _userFirstName :: Columnar f Text
    , _userLastName  :: Columnar f Text
    , _userPassword  :: Columnar f Text
    } deriving Generic

type User = UserT Identity
type UserId = PrimaryKey UserT Identity

deriving instance Show User
deriving instance Eq User
instance Beamable UserT
instance Table UserT where
    data PrimaryKey UserT f = UserId (Columnar f Text) deriving Generic
    primaryKey = UserId . _userEmail
instance Beamable (PrimaryKey UserT)

-- userKey = UserId "[email protected]"

data ShoppingCartDb f = ShoppingCartDb
    { _shoppingCartUsers :: f (TableEntity UserT)
    , _shoppingCartUserAddresses :: f (TableEntity AddressT)
    } deriving Generic

instance Database be ShoppingCartDb

shoppingCartDb :: DatabaseSettings be ShoppingCartDb
shoppingCartDb = defaultDbSettings `withDbModification`
                 dbModification {
                   _shoppingCartUserAddresses =
                     modifyTable (\_ -> "addresses") $
                     tableModification {
                       _addressLine1 = fieldNamed "address1",
                       _addressLine2 = fieldNamed "address2"
                     }
                 }


test :: IO ()
test = do
    conn <- connect defaultConnectInfo

    putStrLn "Sorted Users"
    queryUsersSort conn

    -- putStrLn "Bounded Users"
    -- queryBounded conn

    putStrLn "Count"
    queryCount conn

    putStrLn "Count Names"
    queryCountNames conn



  where
    addUsers conn = do
      runBeamPostgresDebug putStrLn conn $ runInsert $
        insert (_shoppingCartUsers shoppingCartDb) $
        insertValues [ User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c" {- james -}
                    , User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f" {- betty -}
                    , User "[email protected]" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c" {- sam -} ]

    queryUsers conn = do
      let allUsers = all_ (_shoppingCartUsers shoppingCartDb)

      runBeamPostgresDebug putStrLn conn $ do
        users <- runSelectReturningList $ select allUsers
        mapM_ (liftIO . print) users


    queryUsersSort conn = do
      let sortUsersByFirstName = orderBy_ (\u -> (asc_ (_userFirstName u), desc_ (_userLastName u))) (all_ (_shoppingCartUsers shoppingCartDb))

      runBeamPostgresDebug putStrLn conn $ do
        users <- runSelectReturningList $ select sortUsersByFirstName
        mapM_ (liftIO . putStrLn . show) users


    -- queryBounded conn = do
    --   let boundedQuery :: Q PgSelectSyntax _ _ _
    --       boundedQuery = limit_ 1 $ offset_ 1 $
    --                     orderBy_ (asc_ . _userFirstName) $
    --                     all_ (_shoppingCartUsers shoppingCartDb)

    --   runBeamPostgresDebug putStrLn conn $ do
    --     users <- runSelectReturningList (select boundedQuery :: SqlSelect PgSelectSyntax _)
    --     mapM_ (liftIO . putStrLn . show) users


    queryCount conn = do
      let userCount = aggregate_ (\u -> countAll_) (all_ (_shoppingCartUsers shoppingCartDb))

      runBeamPostgresDebug putStrLn conn $ do
        Just c <- runSelectReturningOne $ select userCount
        liftIO $ putStrLn ("We have " ++ show c ++ " users in the database")

    queryCountNames conn = do
      let numberOfUsersByName = aggregate_ (\u -> (group_ (_userFirstName u), countAll_)) $
                                all_ (_shoppingCartUsers shoppingCartDb)

      runBeamPostgresDebug putStrLn conn $ do
        countedByName <- runSelectReturningList $ select numberOfUsersByName
        mapM_ (liftIO . putStrLn . show) countedByName








--- part 2 --------------------------------------

data AddressT f = Address
                { _addressId    :: C f Int
                , _addressLine1 :: C f Text
                , _addressLine2 :: C f (Maybe Text)
                , _addressCity  :: C f Text
                , _addressState :: C f Text
                , _addressZip   :: C f Text

                , _addressForUser :: PrimaryKey UserT f }
                  deriving Generic
type Address = AddressT Identity
deriving instance Show (PrimaryKey UserT Identity)
deriving instance Show Address

instance Table AddressT where
    data PrimaryKey AddressT f = AddressId (Columnar f Int) deriving Generic
    primaryKey = AddressId . _addressId
type AddressId = PrimaryKey AddressT Identity -- For convenience

instance Beamable AddressT
instance Beamable (PrimaryKey AddressT)

Address (LensFor addressId)    (LensFor addressLine1)
        (LensFor addressLine2) (LensFor addressCity)
        (LensFor addressState) (LensFor addressZip)
        (UserId (LensFor addressForUserId)) =
        tableLenses

User (LensFor userEmail)    (LensFor userFirstName)
     (LensFor userLastName) (LensFor userPassword) =
     tableLenses


test2 :: IO ()
test2 = do
    conn <- connect defaultConnectInfo
    print "HELLO"
    insertUsers conn
  where
    insertUsers conn = do
      let james = User "[email protected]" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c"
          betty = User "[email protected]" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f"
          sam = User "[email protected]" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c"
      runBeamPostgresDebug putStrLn conn $ runInsert $
        insert (_shoppingCartUsers shoppingCartDb) $
        insertValues [ james, betty, sam ]

      let addresses = [ Address default_ (val_ "123 Little Street") (val_ Nothing) (val_ "Boston") (val_ "MA") (val_ "12345") (pk james)
                      , Address default_ (val_ "222 Main Street") (val_ (Just "Ste 1")) (val_ "Houston") (val_ "TX") (val_ "8888") (pk betty)
                      , Address default_ (val_ "9999 Residence Ave") (val_ Nothing) (val_ "Sugarland") (val_ "TX") (val_ "8989") (pk betty) ]

      runBeamPostgresDebug putStrLn conn $ runInsert $
        insert (_shoppingCartUserAddresses shoppingCartDb) $
        insertExpressions addresses