Haskell REST API + PostgreSQL

Question

I'm making some small REST API, which I have never done before. I've got some basic stuff working.

Now my job is to add new entities to this, but all my work is reduced to copy-pasting code I have written before with changed schema and entity name.

Can I make it more "generic"? Also it's my first haskell program, please feel free to post your suggestions/critic (I know about unsafe head call, also it seems that OverloadedStrings doesn't work between files, therefore you see in every query casting to Query. If it's possible to avoid that I'll be pleased if you share your knowledge)

main.hs

{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Control.Monad.IO.Class
import Data.Monoid ((<>))
import qualified Data.Text.Lazy as TL
import Database.PostgreSQL.Simple
import qualified Data.ByteString
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Types
import DB
routes :: Connection -> ScottyM ()
routes conn = do 
 get "/users" $ do
 users <- liftIO (selectAll conn getUsersQuery :: IO [User])
 json users
 put "/users" $ do
 user <- jsonData :: ActionM User
 liftIO (insertInto conn insertUserQuery user $ userId user)
 json user
 get "/users/:id" $ do
 id <- param "id" :: ActionM TL.Text
 user <- liftIO (selectById conn id getUserQueryId :: IO User)
 json user
 get "/teams" $ do
 teams <- liftIO (selectAll conn getTeamsQuery :: IO [Team])
 json teams
 put "/teams" $ do
 team <- jsonData :: ActionM Team
 liftIO (insertInto conn insertTeamQuery team $ teamId team)
 json team
 get "/teams/:id" $ do
 id <- param "id" :: ActionM TL.Text
 team <- liftIO (selectById conn id getTeamQueryId :: IO Team)
 json team
main = do
 conn <- connectPostgreSQL 
 scotty 3000 (routes conn)

database.hs

{-# LANGUAGE OverloadedStrings #-}
module DB where
import Types
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.ToRow
import Database.PostgreSQL.Simple.ToField
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Web.Scotty
import Data.Monoid ((<>))
import Data.Int
getUsersQuery = "select id, first_name, second_name, team from users" :: Query
getTeamsQuery = "select id, name from teams" :: Query
getUserQueryId = "select id, first_name, second_name, team from users where id = (?)" :: Query
getTeamQueryId = "select id, name from teams where id = (?)" :: Query
insertUserQuery = ("insert into users (first_name, second_name, team) values (?, ?, ?)" :: Query,
 "update users set first_name = (?), second_name = (?), team = (?) where id = (?)" :: Query)
insertTeamQuery = ("insert into teams (name) values (?)" :: Query,
 "update teams set name = (?) where id = (?)" :: Query)
selectAll :: FromRow q => Connection -> Query -> IO [q]
selectAll conn q = do
 allRows <- query_ conn q
 return allRows
selectById :: FromRow q => Connection -> TL.Text -> Query -> IO q
selectById conn id q = do
 tableWithOneRow <- query conn q (Only id)
 return (head tableWithOneRow)
insertInto :: ToRow r => Connection -> (Query, Query) -> r -> Maybe Int -> IO Int64
insertInto conn (update, insert) item id = do
 if null $ id
 then execute conn update item
 else execute conn insert (toRow item ++ [toField $ id])

types.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Types where
import GHC.Generics
import Data.Aeson (parseJSON, FromJSON, ToJSON, encode, decode, (.:), (.:?), Value(..))
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.ToRow
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.ToField
import Data.Time.Clock
data User = User { userId :: Maybe Int,
 firstName :: String,
 lastName :: String,
 team :: Int } deriving (Show, Generic) 
instance FromJSON User where
 parseJSON (Object v) = User <$>
 v .:? "userId" <*>
 v .: "firstName" <*>
 v .: "lastName" <*>
 v .: "team"
instance ToJSON User
instance FromRow User where
 fromRow = User <$> field <*> field <*> field <*> field 
instance ToRow User where
 toRow u = [toField (firstName u), toField (lastName u), toField (team u)]
data Team = Team { teamId :: Maybe Int,
 name :: String } deriving (Show, Generic) 
instance FromJSON Team where
 parseJSON (Object v) = Team <$>
 v .:? "teamId" <*>
 v .: "name"
instance ToJSON Team
instance FromRow Team where
 fromRow = Team <$> field <*> field 
instance ToRow Team where
 toRow u = [toField (name u)]

Answer 1

routes could come to look as follows, though I don't know how to automatically fill in those ???.

routes :: Connection -> ScottyM ()
routes conn = do
 foo "/users" getUsersQuery insertUserQuery getUserQueryId
 foo "/teams" getTeamsQuery insertTeamQuery getTeamQueryId
foo :: ???
foo path getXsQuery insertXQuery getXQueryId = do
 get path $ do
 xs <- liftIO (selectAll conn getXsQuery :: IO [???])
 json xs
 put path $ do
 x <- jsonData :: ActionM ???
 liftIO (insertInto conn insertXQuery x $ userId x)
 json user
 get (path ++ "/:id") $ do
 id <- param "id" :: ActionM TL.Text
 x <- liftIO (selectById conn id getXQueryId :: IO ???)
 json x

selectAll is just query_.

Aeson provides ways to derive FromJSON, not sure whether they're applicable.

If you're desperate, you can throw TemplateHaskell at the rest and generate the code yourself.