hpasteExample of using experimental API
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
module Server where
import Server.API
import Server.Migration
import SharedTypes
import Data.Maybe
import Database.PostgreSQL.Simple.Data
import Snap.Core
import Snap.Http.Server
import System.Environment
server :: IO ()
server = do
args <- getArgs
migrate (any (=="-create-version") args)
httpServe (setPort 10002 defaultConfig) (route [("/json",handle dispatcher)])
dispatcher :: Command -> Dispatcher
dispatcher cmd =
case cmd of
NewTask task r -> r <~ do
_ <- transaction $ insertSans [dataField taskId] task
return OK
Tasks r -> r <~ do
fmap List $ transaction $ do
returns $ \a -> do
tasks <- select a [] [desc taskId]
return (map (\(id,title,difficulty,tags,background,what,gohere) ->
Task id title difficulty tags background what gohere)
tasks)
GetTask id r -> r <~ do
transaction $ do
returns $ \a -> do
tasks <- select a [field taskId :=: Int id] []
return (listToMaybe (map (\(id,title,difficulty,tags,background,what,gohere) ->
Task id title difficulty tags background what gohere)
tasks))
|
1:1: Error: Unused LANGUAGE pragma
Found:
{-# LANGUAGE ViewPatterns #-}
Why not remove it.
22:12: Error: Use elem
Found:
any (== "-create-version")
Why not:
elem "-create-version"
32:21: Error: Redundant do
Found:
do fmap List $
transaction $
do returns $
\ a ->
do tasks <- select a [] [desc taskId]
return
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks)
Why not:
fmap List $
transaction $
do returns $
\ a ->
do tasks <- select a [] [desc taskId]
return
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks)
33:33: Error: Redundant do
Found:
do returns $
\ a ->
do tasks <- select a [] [desc taskId]
return
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks)
Why not:
returns $
\ a ->
do tasks <- select a [] [desc taskId]
return
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks)
39:26: Error: Redundant do
Found:
do transaction $
do returns $
\ a ->
do tasks <- select a [field taskId :=: Int id] []
return
(listToMaybe
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks))
Why not:
transaction $
do returns $
\ a ->
do tasks <- select a [field taskId :=: Int id] []
return
(listToMaybe
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks))
40:21: Error: Redundant do
Found:
do returns $
\ a ->
do tasks <- select a [field taskId :=: Int id] []
return
(listToMaybe
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks))
Why not:
returns $
\ a ->
do tasks <- select a [field taskId :=: Int id] []
return
(listToMaybe
(map
(\ (id, title, difficulty, tags, background, what, gohere) ->
Task id title difficulty tags background what gohere)
tasks))