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.