mirror of
https://github.com/aelve/guide.git
synced 2024-12-23 21:02:13 +03:00
Use lenses instead of 0-or-1 traversals
If they fail, Spock will catch the errors anyway
This commit is contained in:
parent
0d51bb67d4
commit
0d21649f81
@ -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
24
src/Main.hs
@ -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 ()
|
||||||
|
Loading…
Reference in New Issue
Block a user