diff options
Diffstat (limited to 'Handler/ReferenceListing.hs')
-rw-r--r-- | Handler/ReferenceListing.hs | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/Handler/ReferenceListing.hs b/Handler/ReferenceListing.hs new file mode 100644 index 0000000..0f777ee --- /dev/null +++ b/Handler/ReferenceListing.hs | |||
@@ -0,0 +1,27 @@ | |||
1 | module Handler.ReferenceListing where | ||
2 | |||
3 | import Import | ||
4 | |||
5 | import Handler.Common | ||
6 | |||
7 | getReferenceListingR, postReferenceListingR :: Handler TypedContent | ||
8 | getReferenceListingR = postReferenceListingR | ||
9 | postReferenceListingR = do | ||
10 | ((insertResult, fsInsertForm), fsInsertEncoding) <- runFormPost $ referenceForm Nothing | ||
11 | |||
12 | mapM_ (addMessage "formError" . toHtml) =<< case insertResult of | ||
13 | FormSuccess newReference -> [] <$ runDB (insert newReference) | ||
14 | FormFailure errors -> return errors | ||
15 | _ -> return [] | ||
16 | |||
17 | reference <- runDB $ selectList [] [Asc ReferenceKind] | ||
18 | |||
19 | selectRep $ do | ||
20 | provideJson (reference :: [Entity Reference]) | ||
21 | provideRep . defaultLayout $ referenceListing ReferenceState | ||
22 | { refFormState = Just InsertForm{..} | ||
23 | , .. | ||
24 | } | ||
25 | |||
26 | putReferenceListingR :: Handler Value | ||
27 | putReferenceListingR = returnJson =<< runDB . insertEntity =<< (requireCheckJsonBody :: Handler Reference) | ||