summaryrefslogtreecommitdiff
path: root/Handler/ReferenceListing.hs
blob: 0f777ee71dd0443af191961118952e13deeeab43 (plain)
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
module Handler.ReferenceListing where

import Import

import Handler.Common

getReferenceListingR, postReferenceListingR :: Handler TypedContent
getReferenceListingR = postReferenceListingR
postReferenceListingR = do
  ((insertResult, fsInsertForm), fsInsertEncoding) <- runFormPost $ referenceForm Nothing

  mapM_ (addMessage "formError" . toHtml) =<< case insertResult of 
    FormSuccess newReference -> [] <$ runDB (insert newReference)
    FormFailure errors -> return errors
    _ -> return []

  reference <- runDB $ selectList [] [Asc ReferenceKind]

  selectRep $ do
    provideJson (reference :: [Entity Reference])
    provideRep . defaultLayout $ referenceListing ReferenceState
      { refFormState = Just InsertForm{..}
      , ..
      }

putReferenceListingR :: Handler Value
putReferenceListingR = returnJson =<< runDB . insertEntity =<< (requireCheckJsonBody :: Handler Reference)