Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Minimize Resource package type and get rid of the "b v a" parameters

  • Loading branch information...
commit 2b06dd0ff23348055eba680d723f280d6408fb7a 1 parent 2d19efd
Ozgun Ataman authored

Showing 1 changed file with 76 additions and 62 deletions. Show diff stats Hide diff stats

  1. +76 62 src/Snap/Restful.hs
138 src/Snap/Restful.hs
@@ -58,29 +58,29 @@ import qualified Blaze.ByteString.Builder.Char8 as Build
58 58 import Control.Applicative
59 59 import Control.Monad
60 60 import Control.Monad.Trans
61   -import Data.ByteString.Char8 (ByteString)
62   -import qualified Data.ByteString.Char8 as B
63   -import Data.Char (toUpper)
  61 +import Data.ByteString.Char8 (ByteString)
  62 +import qualified Data.ByteString.Char8 as B
  63 +import Data.Char (toUpper)
64 64 import Data.Default
65 65 import Data.Int
66   -import qualified Data.Map as M
  66 +import qualified Data.Map as M
67 67 import Data.Monoid
68 68 import Data.Readable
69   -import Data.Text (Text)
70   -import qualified Data.Text as T
71   -import qualified Data.Text.Encoding as T
  69 +import Data.Text (Text)
  70 +import qualified Data.Text as T
  71 +import qualified Data.Text.Encoding as T
72 72 import Data.Time
73 73 import Data.Typeable
74 74 import Data.Word
75 75 import Heist
76   -import qualified Heist.Compiled as C
77   -import qualified Heist.Interpreted as I
  76 +import qualified Heist.Compiled as C
  77 +import qualified Heist.Interpreted as I
78 78 import Snap.Core
79 79 import Snap.Snaplet
80 80 import Snap.Snaplet.Heist
81 81 import System.Locale
82   -import qualified Text.XmlHtml as X
83 82 import Text.Digestive
  83 +import qualified Text.XmlHtml as X
84 84 ------------------------------------------------------------------------------
85 85
86 86
@@ -123,66 +123,80 @@ instance Default DBId where
123 123 instance Readable DBId where fromText = return . DBId <=< fromText
124 124
125 125
126   -data Resource b v a = Resource {
127   - rName :: Text
  126 +data Resource = Resource {
  127 + rName :: Text
128 128 -- ^ A name for this resource
129   - , rRoot :: Text
  129 + , rRoot :: Text
130 130 -- ^ URL root for this resource
131   - , rHandlers :: [(CRUD, Handler b v a)]
132   - -- ^ Standard CRUD handlers
133   - , rResourceActions :: [(Text, Handler b v a)]
134   - -- ^ Additional resource level handlers
135   - , rItemActions :: [(Text, Handler b v a)]
136   - -- ^ Additional resource instance/item level handlers
137   - }
  131 + , rResourceEndpoints :: [Text]
  132 + -- ^ Resource level routing end points
  133 + , rItemEndpoints :: [Text]
  134 + -- ^ Item/instance level routing end points
  135 +}
138 136
139   -instance Default (Resource b v a) where
140   - def = Resource "items" "/items" [] [] []
  137 +instance Default Resource where
  138 + def = Resource "items" "/items" [] []
141 139
142 140
143 141 ------------------------------------------------------------------------------
144 142 -- | One-stop convenience function to enable RESTful resources in your
145 143 -- application. Call this function from your initializer passing it all of
146 144 -- your resources and it will add the routes and splices for you.
147   -initRest :: HasHeist b => [Resource b v ()] -> Initializer b v ()
148   -initRest resources = do
149   - let splices = concatMap resourceSplices resources
150   - routes = concatMap resourceRoutes resources
  145 +initRest :: HasHeist b
  146 + => Resource
  147 + -- ^ Resource definition
  148 + -> [(CRUD, Handler b v ())]
  149 + -- ^ Standard CRUD handlers
  150 + -> [(Text, Handler b v ())]
  151 + -- ^ Additional resource level handlers
  152 + -> [(Text, Handler b v ())]
  153 + -- ^ Additional instance/item level handlers
  154 + -> Initializer b v ()
  155 +initRest res rHandlers rResourceActions rItemActions = do
  156 + let splices = resourceSplices res
  157 + routes = resourceRoutes res rHandlers rResourceActions rItemActions
151 158 addSplices splices
152 159 addRoutes routes
153 160
154 161
155 162 ------------------------------------------------------------------------------
156   -resourceRoutes :: Resource b v a -> [(ByteString, Handler b v a)]
157   -resourceRoutes r@Resource{..} =
  163 +-- | See 'initRest' for an explanation of the arguments to this function
  164 +resourceRoutes
  165 + :: MonadSnap m
  166 + => Resource
  167 + -> [(CRUD, m a)]
  168 + -> [(Text, m a)]
  169 + -> [(Text, m a)]
  170 + -> [(ByteString, m a)]
  171 +resourceRoutes r rHandlers rResourceActions rItemActions =
158 172 map (mkCrudRoute r) rHandlers ++
159 173 map (mkResourceRoute r) rResourceActions ++
160 174 map (mkItemRoute r) rItemActions
161 175
162 176
163 177 ------------------------------------------------------------------------------
164   -resourceRouter :: Resource b v a -> Handler b v a
165   -resourceRouter = route . resourceRoutes
  178 +resourceRouter :: MonadSnap m => Resource -> [(CRUD, m a)] -> [(Text, m a)] -> [(Text, m a)] -> m a
  179 +resourceRouter r as bs cs = route $ resourceRoutes r as bs cs
166 180
167 181
168 182 mkPath = T.intercalate "/" . filter (not . T.null)
169 183 mkPathB = B.intercalate "/" . filter (not . B.null)
170 184
171 185 ------------------------------------------------------------------------------
172   -mkItemRoute :: Resource t t1 t2 -> (Text, t3) -> (ByteString, t3)
  186 +mkItemRoute :: Resource -> (Text, t3) -> (ByteString, t3)
173 187 mkItemRoute Resource{..} (act, h) =
174 188 (T.encodeUtf8 $ mkPath [rRoot, ":id", act], h)
175 189
176 190
177 191 ------------------------------------------------------------------------------
178   -mkResourceRoute :: Resource t t1 t2 -> (Text, t3) -> (ByteString, t3)
  192 +mkResourceRoute :: Resource -> (Text, t3) -> (ByteString, t3)
179 193 mkResourceRoute Resource{..} (act, h) =
180 194 (T.encodeUtf8 $ mkPath [rRoot, act], h)
181 195
182 196
183 197 ------------------------------------------------------------------------------
184 198 mkCrudRoute :: MonadSnap m
185   - => Resource b v a -> (CRUD, m a) -> (ByteString, m a)
  199 + => Resource -> (CRUD, m a) -> (ByteString, m a)
186 200 mkCrudRoute r@Resource{..} (crud, h) =
187 201 case crud of
188 202 RIndex -> (T.encodeUtf8 rRoot, ifTop $ method GET h)
@@ -207,7 +221,7 @@ mkCrudRoute r@Resource{..} (crud, h) =
207 221
208 222 ------------------------------------------------------------------------------
209 223 -- | Return heist template location for given crud action
210   -templatePath :: Resource t t1 t2 -> CRUD -> ByteString
  224 +templatePath :: Resource -> CRUD -> ByteString
211 225 templatePath Resource{..} crud =
212 226 case crud of
213 227 RIndex -> mkPathB [r, "index"]
@@ -222,7 +236,7 @@ templatePath Resource{..} crud =
222 236
223 237
224 238 ------------------------------------------------------------------------------
225   ---crudPath :: Resource b v a -> CRUD -> DBId -> Text
  239 +--crudPath :: Resource -> CRUD -> DBId -> Text
226 240 --crudPath Resource{..} crud DBId{..} =
227 241 -- case crud of
228 242 -- RIndex -> rRoot
@@ -236,48 +250,48 @@ templatePath Resource{..} crud =
236 250
237 251
238 252 ------------------------------------------------------------------------------
239   -itemActionPath :: Resource t t1 t2 -> Text -> DBId -> Text
  253 +itemActionPath :: Resource -> Text -> DBId -> Text
240 254 itemActionPath Resource{..} t DBId{..} =
241 255 mkPath [rRoot, showT unDBId, t]
242 256
243 257
244 258 ------------------------------------------------------------------------------
245   -indexPath :: Resource b v a -> Text
  259 +indexPath :: Resource -> Text
246 260 indexPath r = rRoot r
247 261
248 262
249 263 ------------------------------------------------------------------------------
250   -createPath :: Resource b v a -> Text
  264 +createPath :: Resource -> Text
251 265 createPath r = rRoot r
252 266
253 267
254 268 ------------------------------------------------------------------------------
255   -newPath :: Resource b v a -> Text
  269 +newPath :: Resource -> Text
256 270 newPath r = mkPath [rRoot r, "new"]
257 271
258 272
259 273 ------------------------------------------------------------------------------
260   -rootPath :: Resource b v a -> Text
  274 +rootPath :: Resource -> Text
261 275 rootPath = indexPath
262 276
263 277
264 278 ------------------------------------------------------------------------------
265   -editPath :: Resource b v a -> DBId -> Text
  279 +editPath :: Resource -> DBId -> Text
266 280 editPath r (DBId _id) = mkPath [rRoot r, showT _id, "edit"]
267 281
268 282
269 283 ------------------------------------------------------------------------------
270   -showPath :: Resource b v a -> DBId -> Text
  284 +showPath :: Resource -> DBId -> Text
271 285 showPath r (DBId _id) = mkPath [rRoot r, showT _id]
272 286
273 287
274 288 ------------------------------------------------------------------------------
275   -updatePath :: Resource b v a -> DBId -> Text
  289 +updatePath :: Resource -> DBId -> Text
276 290 updatePath r (DBId _id) = mkPath [rRoot r, showT _id]
277 291
278 292
279 293 ------------------------------------------------------------------------------
280   -destroyPath :: Resource b v a -> DBId -> Text
  294 +destroyPath :: Resource -> DBId -> Text
281 295 destroyPath r (DBId _id) = mkPath [rRoot r, showT _id, "destroy"]
282 296
283 297
@@ -294,7 +308,7 @@ getFormAction = do
294 308
295 309
296 310 -------------------------------------------------------------------------------
297   -resourceSplices :: Monad m => Resource b v a -> [(Text, HeistT n m Template)]
  311 +resourceSplices :: Monad m => Resource -> [(Text, HeistT n m Template)]
298 312 resourceSplices r@Resource{..} =
299 313 [ (T.concat [rName, "NewPath"], I.textSplice $ newPath r)
300 314 , (T.concat [rName, "IndexPath"], I.textSplice $ indexPath r)
@@ -307,9 +321,9 @@ resourceSplices r@Resource{..} =
307 321 ]
308 322
309 323 ------------------------------------------------------------------------------
310   -itemSplices :: Monad m => Resource b v a -> DBId -> [(Text, I.Splice m)]
  324 +itemSplices :: Monad m => Resource -> DBId -> [(Text, I.Splice m)]
311 325 itemSplices r@Resource{..} dbid =
312   - map (mkItemActionSplice r dbid . fst) rItemActions ++
  326 + map (mkItemActionSplice r dbid) rItemEndpoints ++
313 327 [ (T.concat [rName, "ItemEditPath"], I.textSplice $ editPath r dbid)
314 328 , (T.concat [rName, "ItemShowPath"], I.textSplice $ showPath r dbid)
315 329 , (T.concat [rName, "ItemUpdatePath"], I.textSplice $ updatePath r dbid)
@@ -321,14 +335,14 @@ itemSplices r@Resource{..} dbid =
321 335
322 336
323 337 -------------------------------------------------------------------------------
324   -resourceCSplices :: MonadSnap m => Resource b v a -> [(Text, C.Splice m)]
  338 +resourceCSplices :: MonadSnap m => Resource -> [(Text, C.Splice m)]
325 339 resourceCSplices r = C.mapSnd (C.runNodeList =<<) (resourceSplices r)
326 340
327 341
328 342 ------------------------------------------------------------------------------
329   -itemCSplices :: Resource b v a
  343 +itemCSplices :: Resource
330 344 -> [(Text, DBId -> Text)]
331   -itemCSplices r@Resource{..} =
  345 +itemCSplices r@Resource{..} =
332 346 [ (T.concat [rName, "ItemEditPath"], editPath r)
333 347 , (T.concat [rName, "ItemShowPath"], showPath r)
334 348 , (T.concat [rName, "ItemUpdatePath"], updatePath r)
@@ -339,19 +353,19 @@ itemCSplices r@Resource{..} =
339 353 , (T.concat [rName, "ItemIndexPath"], indexPath r)
340 354 , (T.concat [rName, "ItemCreatePath"], createPath r)
341 355 ] ++
342   - map (mkItemActionCSplice r . fst) rItemActions
  356 + map (mkItemActionCSplice r) rItemEndpoints
343 357
344 358
345 359 -------------------------------------------------------------------------------
346 360 mkItemActionSplice :: Monad m
347   - => Resource b v a -> DBId -> Text -> (Text, I.Splice m)
  361 + => Resource -> DBId -> Text -> (Text, I.Splice m)
348 362 mkItemActionSplice r@Resource{..} dbid t =
349 363 ( T.concat [rName, "Item", cap t, "Path"]
350 364 , I.textSplice $ itemActionPath r t dbid)
351 365
352 366
353 367 -------------------------------------------------------------------------------
354   -mkItemActionCSplice :: Resource b v a -> Text -> (Text, DBId -> Text)
  368 +mkItemActionCSplice :: Resource -> Text -> (Text, DBId -> Text)
355 369 mkItemActionCSplice r@Resource{..} t =
356 370 ( T.concat [rName, "Item", cap t, "Path"]
357 371 , itemActionPath r t)
@@ -359,7 +373,7 @@ mkItemActionCSplice r@Resource{..} t =
359 373
360 374 ------------------------------------------------------------------------------
361 375 -- | Redirect to given item's default show page
362   -redirToItem :: MonadSnap m => Resource b v a -> DBId -> m a
  376 +redirToItem :: MonadSnap m => Resource -> DBId -> m a
363 377 redirToItem r dbid = redirect . T.encodeUtf8 $ showPath r dbid
364 378
365 379
@@ -417,11 +431,11 @@ validDate = maybe (Error "invalid date") Success .
417 431
418 432
419 433 dayText :: Day -> Text
420   -dayText = T.pack . formatTime defaultTimeLocale "%F"
  434 +dayText = T.pack . formatTime defaultTimeLocale "%F"
421 435
422 436
423 437 ------------------------------------------------------------------------------
424   --- | A simple formlet for dates that
  438 +-- | A simple formlet for dates that
425 439 simpleDateFormlet :: (Monad m)
426 440 => Maybe Day -> Form Text m Day
427 441 simpleDateFormlet d = validate validDate $
@@ -429,7 +443,7 @@ simpleDateFormlet d = validate validDate $
429 443
430 444
431 445 ------------------------------------------------------------------------------
432   --- |
  446 +-- |
433 447 class PrimSplice a where
434 448 iPrimSplice :: Monad m => a -> m [X.Node]
435 449 cPrimSplice :: a -> Builder
@@ -511,7 +525,7 @@ instance PrimSplice a => PrimSplice (Maybe a) where
511 525 -- class HasSplices a where
512 526 -- iSplices :: (Monad m) => a -> [(Text, I.Splice m)]
513 527 -- -- cSplices :: (Monad m) => [(Text, C.Promise a -> C.Splice m)]
514   ---
  528 +--
515 529 -- instance HasSplices String where
516 530 -- iSplices x = [("", I.textSplice $ T.pack x)]
517 531 -- instance HasSplices Text where
@@ -524,7 +538,7 @@ instance PrimSplice a => PrimSplice (Maybe a) where
524 538 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
525 539 -- instance HasSplices Double where
526 540 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
527   ---
  541 +--
528 542 -- instance HasSplices Int8 where
529 543 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
530 544 -- instance HasSplices Int16 where
@@ -533,7 +547,7 @@ instance PrimSplice a => PrimSplice (Maybe a) where
533 547 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
534 548 -- instance HasSplices Int64 where
535 549 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
536   ---
  550 +--
537 551 -- instance HasSplices Word8 where
538 552 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
539 553 -- instance HasSplices Word16 where
@@ -542,10 +556,10 @@ instance PrimSplice a => PrimSplice (Maybe a) where
542 556 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
543 557 -- instance HasSplices Word64 where
544 558 -- iSplices x = [("", I.textSplice $ T.pack $ show x)]
545   ---
  559 +--
546 560 -- instance HasSplices Day where
547 561 -- iSplices = iSplices . dayText
548   ---
  562 +--
549 563 -- instance HasSplices a => HasSplices (Maybe a) where
550 564 -- iSplices Nothing = [("", I.textSplice "")]
551 565 -- iSplices (Just x) = iSplices x

0 comments on commit 2b06dd0

Please sign in to comment.
Something went wrong with that request. Please try again.