nuttycom/aftok - Change XTBSG4C7SCZUFOU2BTNFR6B6TCGYI35BWUV4PVTS3N7KNH5VEARQC

Adding serveJSON combinator to eliminate some boilerplate from handlers.

Created by Kris Nuttycombe on March 17, 2015

XTBSG4C7SCZUFOU2BTNFR6B6TCGYI35BWUV4PVTS3N7KNH5VEARQC

Dependencies

In channels

main

Change contents

Deletion in lib/Quixotic/Database/PostgreSQL.hs at line 217 [4.456]
B:BD[3.1369] → [3.1369:1370]
Replacement in lib/Quixotic/Json.hs at line 9 [5.19]
B:BD[5.215] → [5.215:231]
```
import Data.Map
```
[5.215]
[5.231]
```
import qualified Data.Map as M
```
Replacement in lib/Quixotic/Json.hs at line 20 [5.19]
B:BD[6.2143] → [2.3779:3816]
```
    toJSON $ mapKeys (^. _BtcAddr) p
```
[6.2143]
[5.484]
```
    toJSON $ M.mapKeys (^. _BtcAddr) p
```

Replacement in lib/Quixotic/Json.hs at line 24 [5.19]

B:BD[7.748] → [6.2178:2225]

    PayoutsJ . mapKeys BtcAddr <$> parseJSON v

[7.748]

[6.2225]

    PayoutsJ . M.mapKeys BtcAddr <$> parseJSON v

Insertion in lib/Quixotic/Json.hs at line 37 [5.19]

[6.2559]

[5.485]


newtype ProjectJ = ProjectJ Project
makePrisms ''ProjectJ
instance ToJSON ProjectJ where
  toJSON (ProjectJ p) = 
    object [ "projectName"    .= (p ^. projectName)
           , "inceptionDate"  .= (p ^. inceptionDate)
           , "initiator"      .= (p ^. (initiator._UserId)) ]

Insertion in lib/Quixotic/Json.hs at line 47 [5.19]
[5.486]
[6.2560]
```
newtype WidxJ = WidxJ WorkIndex
makePrisms ''WidxJ
```

Insertion in lib/Quixotic/Json.hs at line 50 [5.19]

[6.2561]

instance ToJSON WidxJ where
  toJSON (WidxJ widx) = 
    toJSON $ (fmap IntervalJ) <$> (M.mapKeysWith (++) (^._BtcAddr) widx)

Insertion in server/Main.hs at line 10 [9.5188]
[8.170]
[5.918]
```
import qualified Data.Aeson as A
```
Insertion in server/Main.hs at line 13 [9.5188]
[10.2567]
[5.942]
```
import Quixotic.Json
```

Replacement in server/Main.hs at line 57 [9.5188]

B:BD[11.1105] → [11.1105:1196]

∅:D[11.1196] → [12.1826:1879]

B:BD[6.3862] → [12.1826:1879]

B:BD[12.1879] → [11.1197:1396]

            , ("projects/:projectId/log/:btcAddr",      method GET loggedIntervalsHandler)
            , ("projects/:projectId", method GET ok)
            , ("projects", void $ method POST projectCreateHandler)
            , ("projects", void $ method GET  projectListHandler)
            , ("payouts/:projectId",  method GET payoutsHandler)

[11.1105]

[4.8999]

            , ("projects/:projectId/log/:btcAddr",      serveJSON WidxJ $ method GET loggedIntervalsHandler)
            , ("projects/:projectId", serveJSON ProjectJ $ method GET projectGetHandler)
            , ("projects",            void $ method POST projectCreateHandler)
            , ("projects",            serveJSON (fmap (ProjectJ._project)) $ method GET projectListHandler)
            , ("payouts/:projectId",  serveJSON PayoutsJ $ method GET payoutsHandler)

Insertion in server/Main.hs at line 90 [9.5188]

[8.1197]


serveJSON :: (MonadSnap m, A.ToJSON a) => (b -> a) -> m b -> m ()
serveJSON f ma = do
  modifyResponse $ addHeader "content-type" "application/json"
  writeLBS =<< (A.encode . f <$> ma)

Insertion in server/Quixotic/Snaplet/Projects.hs at line 24 [12.2363]
[12.2914]
[12.2914]
```
projectGetHandler :: Handler App App Project
projectGetHandler = ok
```

Replacement in server/Quixotic/Snaplet/Projects.hs at line 37 [12.2363]

B:BD[12.3443] → [12.3443:3516]

projectListHandler :: Handler App App [Project]
projectListHandler = ok

[12.3443]

projectListHandler :: Handler App App [QDBProject]
projectListHandler = do
  QDB{..} <- view qdb <$> with qm get
  uid <- requireUserId
  liftPG . runReaderT $ findUserProjects uid

Deletion in server/Quixotic/Snaplet/WorkLog.hs at line 8 [13.5424]
B:BD[13.5625] → [2.4291:4322]
```
import qualified Data.Map as M
```
Deletion in server/Quixotic/Snaplet/WorkLog.hs at line 11 [13.5424]
B:BD[13.5683] → [13.5683:5704]
```
import Quixotic.Json
```
Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 35 [13.5424]
B:BD[13.6348] → [13.6348:6393]
```
loggedIntervalsHandler :: Handler App App ()
```
[13.6348]
[14.3428]
```
loggedIntervalsHandler :: Handler App App WorkIndex
```

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 40 [13.5424]

B:BD[14.3515] → [14.3515:3565]

∅:D[14.3565] → [13.6518:6581]

B:BD[13.6518] → [13.6518:6581]

B:BD[13.6581] → [2.4461:4546]

  widx <- liftPG . runReaderT $ readWorkIndex pid
  modifyResponse $ addHeader "content-type" "application/json"
  writeLBS . A.encode . fmap (fmap IntervalJ) $ M.mapKeysWith (++) (^._BtcAddr) widx

[14.3515]

[13.6631]

  liftPG . runReaderT $ readWorkIndex pid

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 42 [13.5424]
B:BD[13.6632] → [13.6632:6669]
```
payoutsHandler :: Handler App App ()
```
[13.6632]
[14.3650]
```
payoutsHandler :: Handler App App Payouts
```

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 49 [13.5424]

B:BD[13.6823] → [13.6823:6886]

B:BD[13.6886] → [6.4209:4266]

  modifyResponse $ addHeader "content-type" "application/json"
  writeLBS . A.encode . PayoutsJ $ payouts df ptime widx

[13.6779]

[14.3781]

  pure $ payouts df ptime widx

Adding serveJSON combinator to eliminate some boilerplate from handlers.

Dependencies

In channels

Change contents

Deletion in lib/Quixotic/Database/PostgreSQL.hs at line 217 [4.456]

Replacement in lib/Quixotic/Json.hs at line 9 [5.19]

Replacement in lib/Quixotic/Json.hs at line 20 [5.19]

Replacement in lib/Quixotic/Json.hs at line 24 [5.19]

Insertion in lib/Quixotic/Json.hs at line 37 [5.19]

Insertion in lib/Quixotic/Json.hs at line 47 [5.19]

Insertion in lib/Quixotic/Json.hs at line 50 [5.19]

Insertion in server/Main.hs at line 10 [9.5188]

Insertion in server/Main.hs at line 13 [9.5188]

Replacement in server/Main.hs at line 57 [9.5188]

Insertion in server/Main.hs at line 90 [9.5188]

Insertion in server/Quixotic/Snaplet/Projects.hs at line 24 [12.2363]

Replacement in server/Quixotic/Snaplet/Projects.hs at line 37 [12.2363]

Deletion in server/Quixotic/Snaplet/WorkLog.hs at line 8 [13.5424]

Deletion in server/Quixotic/Snaplet/WorkLog.hs at line 11 [13.5424]

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 35 [13.5424]

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 40 [13.5424]

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 42 [13.5424]

Replacement in server/Quixotic/Snaplet/WorkLog.hs at line 49 [13.5424]