Permalink
Browse files

Alpha release of new snaplet infrastructure.

  • Loading branch information...
1 parent 719223b commit b0fadff5c5cb2ec7301c6c6cfcc17c68537219c7 @mightybyte mightybyte committed Jul 25, 2011
Showing with 4,072 additions and 1,177 deletions.
  1. +3 −0 .ghci
  2. +1 −0 .gitignore
  3. +60 −0 CHECKLIST.md
  4. +1 −4 CONTRIBUTORS
  5. +133 −0 design.md
  6. +68 −0 examples/App.hs
  7. +1 −0 log/placeholder
  8. +0 −53 project_template/default/src/Snap/Extension/Timer.hs
  9. +0 −67 project_template/default/src/Snap/Extension/Timer/Impl.hs
  10. +5 −0 resources/templates/foo.tpl
  11. +10 −0 resources/templates/index.tpl
  12. +8 −0 resources/templates/page.tpl
  13. +9 −0 resources/templates/session.tpl
  14. +63 −34 snap.cabal
  15. +0 −500 src/Snap/Extension.hs
  16. +0 −79 src/Snap/Extension/Heist.hs
  17. +0 −219 src/Snap/Extension/Heist/Impl.hs
  18. +0 −138 src/Snap/Extension/Server.hs
  19. +5 −5 src/Snap/{Extension → }/Loader/Devel.hs
  20. +1 −1 src/Snap/{Extension → }/Loader/Devel/Evaluator.hs
  21. +1 −1 src/Snap/{Extension → }/Loader/Devel/Signal.hs
  22. +1 −1 src/Snap/{Extension → }/Loader/Devel/TreeWatcher.hs
  23. +312 −0 src/Snap/Snaplet.hs
  24. +67 −0 src/Snap/Snaplet/Auth.hs
  25. +79 −0 src/Snap/Snaplet/Auth/Handlers.hs
  26. +100 −0 src/Snap/Snaplet/Auth/Password.hs
  27. +361 −0 src/Snap/Snaplet/Auth/Types.hs
  28. +201 −0 src/Snap/Snaplet/Heist.hs
  29. +323 −0 src/Snap/Snaplet/HeistNoClass.hs
  30. +381 −0 src/Snap/Snaplet/Internal/Initializer.hs
  31. +111 −0 src/Snap/Snaplet/Internal/Lens.hs
  32. +122 −0 src/Snap/Snaplet/Internal/RST.hs
  33. +325 −0 src/Snap/Snaplet/Internal/Types.hs
  34. +105 −0 src/Snap/Snaplet/Session.hs
  35. +162 −0 src/Snap/Snaplet/Session/Backends/CookieSession.hs
  36. +43 −0 src/Snap/Snaplet/Session/Common.hs
  37. +90 −0 src/Snap/Snaplet/Session/Helpers.hs
  38. +96 −0 src/Snap/Snaplet/Session/SecureCookie.hs
  39. +54 −0 src/Snap/Snaplet/Session/SessionManager.hs
  40. +3 −0 test/.ghci
  41. +5 −0 test/nestTest.sh
  42. +3 −0 test/non-cabal-appdir/db.cfg
  43. 0 test/non-cabal-appdir/log/placeholder
  44. +6 −0 test/non-cabal-appdir/snaplet.cfg
  45. +2 −0 test/non-cabal-appdir/snaplets/baz/snaplet.cfg
  46. +1 −0 test/non-cabal-appdir/snaplets/baz/templates/bazpage.tpl
  47. +2 −0 test/non-cabal-appdir/snaplets/foosnaplet/snaplet.cfg
  48. +1 −0 test/non-cabal-appdir/snaplets/foosnaplet/templates/foopage.tpl
  49. +1 −0 test/non-cabal-appdir/templates/index.tpl
  50. +1 −0 test/non-cabal-appdir/templates/splicepage.tpl
  51. +0 −21 test/runTests.sh
  52. +50 −0 test/runTestsAndCoverage.sh
  53. +5 −0 test/serveApp.sh
  54. +79 −12 test/snap-testsuite.cabal
  55. +9 −0 test/suite/AppMain.hs
  56. +78 −0 test/suite/NestTest.hs
  57. +64 −0 test/suite/Snap/Snaplet/App.hs
  58. +38 −0 test/suite/Snap/Snaplet/BarSnaplet.hs
  59. +37 −0 test/suite/Snap/Snaplet/FooSnaplet.hs
  60. +44 −0 test/suite/Snap/Snaplet/Tests.hs
  61. +33 −42 test/suite/TestSuite.hs
  62. +27 −0 test/testapp/LICENSE
  63. +50 −0 test/testapp/src/App.hs
  64. +11 −0 test/testapp/templates/index.tpl
  65. +8 −0 test/testapp/templates/page.tpl
  66. +47 −0 test/testapp/testapp.cabal
  67. +165 −0 tutorial.md
View
3 .ghci
@@ -0,0 +1,3 @@
+:set -isrc
+:set -hide-package MonadCatchIO-mtl
+:set -XOverloadedStrings
View
@@ -2,6 +2,7 @@
dist/
*.tix
.hpc
+*.log
*.prof
*.hi
*.o
View
@@ -0,0 +1,60 @@
+Snaplets release checklist
+
+# Base library
+
+ - [ ] basic structure of the snaplets library
+
+ - [X] snaplet nesting / components
+
+ - [ ] configuration
+
+ - Chris is going to switch us to bos's configurator
+
+
+ - [X] solution for on-disk layout
+
+
+ - [ ] haddocks up to standard (Greg)
+
+
+ - [X] test suite with good code coverage
+
+ - A significant amount of this is done already. Code coverage is already
+ over 80%. A few more things are still needed though
+
+
+ - [ ] tutorial documentation for website (Doug)
+
+
+ - [ ] design documentation (probably Doug)
+
+
+ - [ ] Merge in old snap executable and update project templates
+
+
+ - [ ] Get Carl's Hint stuff working
+
+# Stock set of snaplets
+
+ - [ ] session snaplet interface
+
+ - [ ] user/auth snaplet interface
+
+ - [X] heist snaplet
+
+ - [ ] admin panel snaplet
+
+
+# Release stuff
+
+ - [ ] release notes / blog post
+
+-----------------------
+
+# Things for later releases
+
+ - [ ] routing
+
+ - still question marks here, especially re: producing internal links?
+
+
View
@@ -1,8 +1,5 @@
Ozgun Ataman <ozataman@gmail.com>
Doug Beardsley <mightybyte@gmail.com>
Gregory Collins <greg@gregorycollins.net>
-Shu-yu Guo <shu@rfrn.org>
Carl Howells <chowells79@gmail.com>
-Shane O'Brien <shane@duairc.com>
-James Sanders <jimmyjazz14@gmail.com>
-Jacob Stanley <jystic@jystic.com>
+Chris Smith <cdsmith@gmail.com>
View
133 design.md
@@ -0,0 +1,133 @@
+# Snaplet Design
+
+The Snaplet infrastructure was designed with three high-level design goals:
+
+* Request local state
+* Composability
+* Availability
+
+First, request local state means that snaplets should be able to define their
+own state that will be available during request processing. And that state
+should be mutable with scope local to the request.
+
+Composability means that applications and snaplets should be interchangeable,
+and you should be able to build them by gluing together other snaplets.
+
+Availability means that you should be able to access your application state
+without threading it manually through parameters.
+
+## Handler
+
+Implementing the goal of request local state means that we need some kind of a
+Handler monad that will look roughly like a state transformer built on top of
+the Snap monad with the top level application data as the state. To implement
+composability we also need an additional type parameter that can be changed to
+match the scope of the current snaplet. We use the "withReader :: (r1 -> r2)
+-> Reader r2 a -> Reader r1 a" pattern to manage scope changes, but in order
+to make our state composably mutable, we need to enlist the help of lenses
+instead of accessor functions. This allows us to keep only the top level
+state and mutate the current context using the lens.
+
+The LensT monad is our implementation of this abstraction. It is a
+combination of ReaderT and StateT (our RST abstraction). Since the lens is
+not conceptually mutable in the same way as the actual state, it is stored in
+the reader environment. The state monad part is used for the top level state
+b, giving is the following newtype.
+
+newtype LensT b e s m a = LensT (RST (b :-> e) s m a)
+
+LensT comes with a (MonadReader (b :-> e)) instance for retrieving the lens
+and a (MonadState e) instance that uses the lens transparently to achieve
+stateful behavior with the type e. From here the definition of Handler is
+fairly natural:
+
+newtype Handler b e a =
+ Handler (LensT (Snaplet b) (Snaplet e) (Snaplet b) Snap a)
+
+We use "LensT (Snaplet b) (Snaplet e)" instead of "LensT b (Snaplet e)"
+because it is desirable to be able to use the identity lens to construct a
+"Handler b b". The only issue with this formulation is that the lens
+manipulation functions provided by LensT are not what the end user needs. The
+end user has a lens of type (b :-> Snaplet e) created by the mkLabels
+function. But LensT's downcast and withLens functions need (Snaplet b :->
+Snaplet e) lenses. These can be derived easily by composing the user-supplied
+lens with the internal lens (Snaplet a :-> a) derived from the definition of
+the Snaplet data structure.
+
+## Initializer
+
+The second important component of snaplets is initialization. This involves
+setting up the state used by the handlers as well as defining a snaplet's
+routes and cleanup actions, reading on-disk config files, and initializing and
+interacting with other snaplets. Like the Handler monad, Initializer is
+implemented with a LensT. This lets us refer to snaplets using the same
+lenses that we use in Handlers. However, Initialzer has a different state
+type and underlying monad.
+
+The MonadSnaplet type class abstracts functionality common to both the
+Initializer and Handler monads.
+
+During initialization, sometimes you want to modify the result of another
+snaplet's initialization. For instance, maybe you want to add templates or
+bind splices for a sitewide Heist snaplet. Or perhaps you want to add
+controls to the admin panel snaplet. This involves modifying the state of
+other snaplets. It would be nice to use the same lenses and scoped
+modification via top-level state that we use in Handler. But in the
+initializer we don't yet have a fully constructed top-level state object to
+modify. So instead of actually modifying the state directly, we construct
+modifier functions to be applied at the end of initialization. Since these
+functions form a monoid, we can build them up using a WriterT monad.
+
+The Initializer monad is used for both initialization and application
+reloading. When an application is reloaded from the browser, status and error
+messages should go to the browser instead of the console. The printInfo
+function sends messages to the appropriate plate and should be used to
+communicate all initializer status and errors.
+
+## Heist
+
+The Heist snaplet is a fairly complex snaplet that illustrates a number of
+concepts that you may encounter while writing your own snaplets. The biggest
+issue arises because Heist's TemplateState is parameterized by the handler
+monad. This means that if you want to do something like a withChild
+transformation with a lens (b :-> e) you will naturally want to apply the same
+transformation to the Handler parameter of the TemplateState. Unfortunately,
+due to Heist's design, this is computationally intensive, must be performed at
+runtime, and requires that you have a bijection (b :<->: e). To avoid this
+issue, we only use the base application state, (TemplateState (Handler b b)).
+
+The basic functions for manipulating templates are not affected by this
+decision. But the splice functions are more problematic since they are the
+ones that actually use TemplateState's monad parameter.
+
+You will also notice that the Heist snaplet includes a HasHeist type class.
+Normally to use snaplets, you must "call" them using withChild or withSibling,
+passing the lens to the desired snaplet. This is useful because it allows you
+to have multiple instances of the same snaplet. However, there may be times
+when you know you will only ever need a single instance of a particular
+snaplet and you'd like to avoid the need to manually change the context every
+time.
+
+This is where type classes are useful. The HasHeist type class essentially
+defines some global compile-time state associating a particular lens to be
+used for calls to Heist within a particular type. To use Heist, just define a
+HasHeist instance for your application or snaplet type and all the Heist API
+functions will work without needing withChild. Your HasHeist instance will
+look something like this:
+
+ instance HasHeist App App where
+ heistLens = subSnaplet heist
+
+The call to subSnaplet is required because HasHeist needs a lens (Snaplet e
+:-> Snaplet (Heist b)) instead of the lens (e :-> Snaplet (Heist b)) that
+you willll get from mkLabels. We did it this way because it allows us to make
+a default instance using the id function from Control.Category.
+
+ instance HasHeist b (Heist b) where heistLens = id
+
+This allows you the option of using the Heist snaplet without defining the
+HasHeist type class. You will just have to manually change context using
+withChild or withSibling.
+
+
+
View
@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+module Main where
+
+import Data.Record.Label
+import qualified Data.Text as T
+import Snap.Http.Server.Config
+import Snap.Types
+import Snap.Util.FileServe
+
+import Snap.Snaplet
+import Snap.Snaplet.Heist
+import Snap.Snaplet.Session
+import Snap.Snaplet.Session.Backends.CookieSession
+import Text.Templating.Heist
+
+data App = App
+ { _heist :: Snaplet (Heist App)
+ , _session :: Snaplet SessionManager
+ }
+
+type AppHandler = Handler App App
+
+mkLabels [''App]
+
+instance HasHeist App App where
+ heistLens = subSnaplet heist
+
+helloHandler :: AppHandler ()
+helloHandler = writeText "Hello world"
+
+sessionTest :: AppHandler ()
+sessionTest = withSession session $ do
+ withChild session $ do
+ curVal <- getFromSession "foo"
+ case curVal of
+ Nothing -> do
+ setInSession "foo" "bar"
+ Just _ -> return ()
+ list <- withChild session $ (T.pack . show) `fmap` sessionToList
+ csrf <- withChild session $ (T.pack . show) `fmap` csrfToken
+ renderWithSplices "session"
+ [ ("session", liftHeist $ textSplice list)
+ , ("csrf", liftHeist $ textSplice csrf) ]
+
+------------------------------------------------------------------------------
+-- |
+app :: Initializer App App (Snaplet App)
+app = makeSnaplet "app" "An snaplet example application." Nothing $ do
+ h <- nestSnaplet "heist" $ heistInit "resources/templates"
+ withChild heist $ addSplices
+ [("mysplice", liftHeist $ textSplice "YAY, it worked")]
+ s <- nestSnaplet "session" $
+ initCookieSessionManager "config/site_key.txt" "_session" Nothing
+ addRoutes [ ("/hello", helloHandler)
+ , ("/aoeu", withChild heist $ heistServeSingle "foo")
+ , ("", withChild heist heistServe)
+ , ("", withChild heist $ serveDirectory "resources/doc")
+ , ("/sessionTest", sessionTest)
+ ]
+ return $ App h s
+
+main :: IO ()
+main = serveSnaplet emptyConfig app
+
View
@@ -0,0 +1 @@
+placeholder
@@ -1,53 +0,0 @@
-{-|
-
-'Snap.Extension.Timer' exports the 'MonadTimer' interface which allows you to
-keep track of the time at which your application was started. The interface's
-only operation is 'startTime'.
-
-Two splices, 'startTimeSplice' and 'currentTimeSplice' are also provided, for
-your convenience.
-
-'Snap.Extension.Timer.Timer' contains the only implementation of this
-interface and can be used to turn your application's monad into a
-'MonadTimer'.
-
-More than anything else, this is intended to serve as an example Snap
-Extension to any developer wishing to write their own Snap Extension.
-
--}
-
-module Snap.Extension.Timer
- ( MonadTimer(..)
- , startTimeSplice
- , currentTimeSplice
- ) where
-
-import Control.Monad.Trans
-import Data.Time.Clock
-import qualified Data.Text as T
-import Snap.Types
-import Text.Templating.Heist
-import Text.XmlHtml
-
-
-------------------------------------------------------------------------------
--- | The 'MonadTimer' type class. Minimal complete definition: 'startTime'.
-class MonadSnap m => MonadTimer m where
- -- | The time at which your application was last loaded.
- startTime :: m UTCTime
-
-
-------------------------------------------------------------------------------
--- | For your convenience, a splice which shows the start time.
-startTimeSplice :: MonadTimer m => Splice m
-startTimeSplice = do
- time <- lift startTime
- return $ [TextNode $ T.pack $ show $ time]
-
-
-------------------------------------------------------------------------------
--- | For your convenience, a splice which shows the current time.
-currentTimeSplice :: MonadTimer m => Splice m
-currentTimeSplice = do
- time <- lift $ liftIO getCurrentTime
- return $ [TextNode $ T.pack $ show $ time]
Oops, something went wrong.

0 comments on commit b0fadff

Please sign in to comment.