Permalink
Browse files

Testing the recent pastes splice

  • Loading branch information...
1 parent f86870b commit 1f6b396a86c2ccd6baa542d303cfd09122743241 @Palmik committed Mar 21, 2011
Showing with 184 additions and 6 deletions.
  1. +2 −4 src/Main.hs
  2. +67 −0 src/Main.hs~
  3. +34 −0 src/Model/Paste.hs~
  4. +13 −2 src/Site.hs
  5. +68 −0 src/Site.hs~
View
@@ -39,9 +39,7 @@ change.
-}
-module Main
-( main
-) where
+module Main where
#ifdef DEVELOPMENT
import Snap.Extension.Loader.Devel
@@ -64,4 +62,4 @@ main = do
quickHttpServe snap
#else
main = quickHttpServe applicationInitializer site
-#endif
+#endif
View
@@ -0,0 +1,67 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+{-|
+
+This is the entry point for this web server application. It supports
+easily switching between interpreting source and running statically
+compiled code.
+
+In either mode, the generated program should be run from the root of
+the project tree. When it is run, it locates its templates, static
+content, and source files in development mode, relative to the current
+working directory.
+
+When compiled with the development flag, only changes to the
+libraries, your cabal file, or this file should require a recompile to
+be picked up. Everything else is interpreted at runtime. There are a
+few consequences of this.
+
+First, this is much slower. Running the interpreter takes a
+significant chunk of time (a couple tenths of a second on the author's
+machine, at this time), regardless of the simplicity of the loaded
+code. In order to recompile and re-load server state as infrequently
+as possible, the source directories are watched for updates, as are
+any extra directories specified below.
+
+Second, the generated server binary is MUCH larger, since it links in
+the GHC API (via the hint library).
+
+Third, and the reason you would ever want to actually compile with
+development mode, is that it enables a faster development cycle. You
+can simply edit a file, save your changes, and hit reload to see your
+changes reflected immediately.
+
+When this is compiled without the development flag, all the actions
+are statically compiled in. This results in faster execution, a
+smaller binary size, and having to recompile the server for any code
+change.
+
+-}
+
+module Main
+( main
+) where
+
+#ifdef DEVELOPMENT
+import Snap.Extension.Loader.Devel
+import Snap.Http.Server (quickHttpServe)
+#else
+import Snap.Extension.Server
+#endif
+
+import Application
+import Site
+
+main :: IO ()
+#ifdef DEVELOPMENT
+main = do
+ -- All source directories will be watched for updates
+ -- automatically. If any extra directories should be watched for
+ -- updates, include them here.
+ snap <- $(let extraWatcheDirs = ["resources/templates"]
+ in loadSnapTH 'applicationInitializer 'site extraWatcheDirs)
+ quickHttpServe snap
+#else
+main = quickHttpServe applicationInitializer site
+#endif
View
@@ -0,0 +1,34 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Model.Paste
+( Paste(..)
+, getRecentPastes
+, DbAccess
+, MonadMongoDB
+) where
+
+import Control.Monad (liftM)
+import Data.Maybe
+
+import Snap.Extension.DB.MongoDB
+import Snap.Extension.DB.MongoDB.Generics
+
+data Paste = Paste { pasteID :: RecKey
+ , pasteTitle :: String
+ , pasteContent :: String
+ , pasteDescription :: String
+ , pasteLanguage :: String
+ } deriving (Eq, Show)
+
+$(deriveAll ''Paste "PFPaste")
+type instance PF Paste = PFPaste
+
+fromDocList :: (Regular a, FromDoc (PF a)) => [Document] -> [a]
+fromDocList = map fromJust . filter isJust . map fromDoc
+
+getRecentPastes :: (MonadMongoDB m, DbAccess m) => m [Paste]
+getRecentPastes = liftM fromDocList (rest =<< (withDB' $ find (select [] "pastes")))
View
@@ -23,6 +23,7 @@ import Text.Templating.Heist
import Application
import Controller.Paste
+
------------------------------------------------------------------------------
-- | Renders the front page of the sample site.
--
@@ -37,6 +38,7 @@ index = ifTop $ heistLocal (bindSplices indexSplices) $ render "index"
, ("current-time", currentTimeSplice)
]
+
------------------------------------------------------------------------------
-- | Renders the echo page.
echo :: Application ()
@@ -45,13 +47,22 @@ echo = do
heistLocal (bindString "message" (T.decodeUtf8 message)) $ render "echo"
where
decodedParam p = fromMaybe "" <$> getParam p
-
+------------------------------------------------------------------------------
+-- | Render recent pastes
+pastes :: Application ()
+pastes = ifTop $ heistLocal (bindSplices pastesSplices) $ render "pastes"
+ where
+ pastesSplices =
+ [ ("recent-pastes", recentPastesSplice)
+ ]
+
------------------------------------------------------------------------------
-- | The main entry point handler.
site :: Application ()
site = route [ ("/", index)
, ("/echo/:stuff", echo)
+ , ("/pastes", pastes)
]
- <|> serveDirectory "resources/static"
+ <|> serveDirectory "resources/static"
View
@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+
+This is where all the routes and handlers are defined for your site. The
+'site' function combines everything together and is exported by this module.
+
+-}
+
+module Site
+( site
+) where
+
+import Control.Applicative
+import Data.Maybe
+import qualified Data.Text.Encoding as T
+import Snap.Extension.Heist
+import Snap.Extension.Timer
+import Snap.Util.FileServe
+import Snap.Types
+import Text.Templating.Heist
+
+import Application
+import Controller.Paste
+
+
+------------------------------------------------------------------------------
+-- | Renders the front page of the sample site.
+--
+-- The 'ifTop' is required to limit this to the top of a route.
+-- Otherwise, the way the route table is currently set up, this action
+-- would be given every request.
+index :: Application ()
+index = ifTop $ heistLocal (bindSplices indexSplices) $ render "index"
+ where
+ indexSplices =
+ [ ("start-time", startTimeSplice)
+ , ("current-time", currentTimeSplice)
+ ]
+
+
+------------------------------------------------------------------------------
+-- | Renders the echo page.
+echo :: Application ()
+echo = do
+ message <- decodedParam "stuff"
+ heistLocal (bindString "message" (T.decodeUtf8 message)) $ render "echo"
+ where
+ decodedParam p = fromMaybe "" <$> getParam p
+
+
+------------------------------------------------------------------------------
+-- | Render recent pastes
+pastes :: Application ()
+echo = ifTop $ heistLocal (bindSplices pastesSplices) $ render "pastes"
+ where
+ pastesSplices =
+ [ ("recent-pastes", recentPastesSplice)
+ ]
+
+------------------------------------------------------------------------------
+-- | The main entry point handler.
+site :: Application ()
+site = route [ ("/", index)
+ , ("/echo/:stuff", echo)
+ , ("/pastes", pastes)
+ ]
+ <|> serveDirectory "resources/static"

0 comments on commit 1f6b396

Please sign in to comment.