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)]