beyond clojure: haskell

json.hs

[persistLowerCase|
Player
  name String
  level Int
  deriving Show
  deriving Generic
|]

instance ToJSON Player
instance FromJSON Player

maybet.hs

-- Flattening 2 nested calls that returns Maybe
getPlayer' = do
  player <- runMaybeT $ do
    param <- MaybeT $ getParam "player"
    MaybeT . runPersist . getPlayer $ BS.unpack param
  return player

migrate.hs

setupDB = do
  runMigration migrateAll
  insert_ $ Player "Sally" 2
  insert_ $ Player "Lance" 1
  insert_ $ Player "Aki" 3
  insert_ $ Player "Maria" 4

patterns.hs

createPlayerHandler = do
  player <- getPlayer'
  name <- getParam "player"
  level <- getPostParam "level"
  case (player, name, level) of
    (Nothing, Just n, Just l) -> do
      runPersist $ createPlayer (BS.unpack n) $ read (BS.unpack l)
      modifyResponse $ setResponseStatus 201 "Created"
    (Just _, _, _) -> modifyResponse $ setResponseStatus 400 "Player exists"
    _ -> notFound

routes.hs

-- Setting up the routes
appInit = makeSnaplet "app" "a player db backend" Nothing $ do
  addRoutes [ ("", ifTop $ writeText "Welcome to the Players API v0.1")
            , ("players", method GET getPlayersHandler)
            , ("players/:player", method GET getPlayerHandler <|>
                                  method POST createPlayerHandler <|>
                                  method DELETE deletePlayerHandler)
            ]
  d <- nestSnaplet "db" db $ initSqlite setupDB
  return $ App d

-- A simple handler
getPlayersHandler = do
  users <- runPersist getAllPlayers
  writeJSON users

-- A model/db function
getAllPlayers = do
  players <- select $ from $ \player -> do
    orderBy [asc (player ^. PlayerName)]
    return player
  return $ map entityVal players