aelve/guide
1
1
Fork 0
mirror of https://github.com/aelve/guide.git synced 2024-12-24 13:26:08 +03:00
Code Issues Projects Releases Wiki Activity

Use lenses instead of 0-or-1 traversals

Browse Source 
If they fail, Spock will catch the errors anyway
This commit is contained in:
Artyom 2016-02-17 22:47:52 +03:00
parent 0d51bb67d4
commit 0d21649f81
2 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hslibs.cabal
View File

@ -30,7 +30,7 @@ executable hslibs
, base >=4.8 && <4.9 , base >=4.8 && <4.9
, base-prelude , base-prelude
, lucid , lucid
, microlens-platform , microlens-platform >= 0.2.3
, mtl , mtl
, text , text
, text-format , text-format

24
src/Main.hs
View File

@ -58,12 +58,13 @@ data S = S {
makeLenses ''S makeLenses ''S
categoryById :: UID -> Traversal' S Category categoryById :: UID -> Lens' S Category
categoryById uid = categories . each . filtered ((== uid) . view catId) categoryById uid = singular $
categories.each . filtered ((== uid) . view catId)
itemById :: UID -> Traversal' S Item itemById :: UID -> Lens' S Item
itemById uid = categories . each . itemById uid = singular $
items . each . filtered ((== uid) . view itemId) categories.each . items.each . filtered ((== uid) . view itemId)
newId :: IORef S -> IO UID newId :: IORef S -> IO UID
newId s = do newId s = do
@ -118,7 +119,6 @@ main = runSpock 8080 $ spockT id $ do
-- TODO: rename methods to “category/add” etc -- TODO: rename methods to “category/add” etc
-- TODO: move Javascript here -- TODO: move Javascript here
-- TODO: turn traversals into lenses
Spock.post "/add/category" $ do Spock.post "/add/category" $ do
title' <- param' "title" title' <- param' "title"
id' <- liftIO (newId stateVar) id' <- liftIO (newId stateVar)
@ -150,31 +150,29 @@ main = runSpock 8080 $ spockT id $ do
content <- param' "content" content <- param' "content"
changedItem <- withS $ do changedItem <- withS $ do
itemById itemId' . pros %= (++ [content]) itemById itemId' . pros %= (++ [content])
gets (^?! itemById itemId') use (itemById itemId')
lucid $ renderItem changedItem lucid $ renderItem changedItem
Spock.post ("/add/cons" <//> var) $ \itemId' -> do Spock.post ("/add/cons" <//> var) $ \itemId' -> do
content <- param' "content" content <- param' "content"
changedItem <- withS $ do changedItem <- withS $ do
itemById itemId' . cons %= (++ [content]) itemById itemId' . cons %= (++ [content])
gets (^?! itemById itemId') use (itemById itemId')
lucid $ renderItem changedItem lucid $ renderItem changedItem
Spock.post ("/edit/category" <//> var <//> "title") $ \catId' -> do Spock.post ("/edit/category" <//> var <//> "title") $ \catId' -> do
title' <- param' "title" title' <- param' "title"
changedCategory <- withS $ do changedCategory <- withS $ do
categoryById catId' . title .= title' categoryById catId' . title .= title'
gets (^?! categoryById catId') use (categoryById catId')
lucid $ renderCategoryHeading changedCategory lucid $ renderCategoryHeading changedCategory
Spock.get ("/edit/category" <//> var <//> "title/edit") $ \catId' -> do Spock.get ("/edit/category" <//> var <//> "title/edit") $ \catId' -> do
category <- withS $ do category <- withS $ use (categoryById catId')
gets (^?! categoryById catId')
lucid $ renderCategoryHeadingEdit category lucid $ renderCategoryHeadingEdit category
Spock.get ("/edit/category" <//> var <//> "title/cancel") $ \catId' -> do Spock.get ("/edit/category" <//> var <//> "title/cancel") $ \catId' -> do
category <- withS $ do category <- withS $ use (categoryById catId')
gets (^?! categoryById catId')
lucid $ renderCategoryHeading category lucid $ renderCategoryHeading category
renderRoot :: S -> Html () renderRoot :: S -> Html ()