diff --git a/demo/Main.hs b/demo/Main.hs new file mode 100644 index 00000000..ae5d6c9f --- /dev/null +++ b/demo/Main.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module Main where + +import Control.Applicative ((<$>)) +import Wiki +import Yesod + +-- A very simple App, doesn't do anything except provide the Wiki. +data App = App + { appWiki :: Wiki + } + +mkYesod "App" [parseRoutes| +/ HomeR GET +/wiki WikiR Wiki appWiki +|] + +instance Yesod App +instance YesodWiki App -- Just use the defaults +instance RenderMessage App FormMessage where + renderMessage _ _ = defaultFormMessage + +getHomeR :: Handler Html +getHomeR = defaultLayout + [whamlet| +
+ Welcome to my test application.
+ The application is pretty boring.
+ You probably want to go to
+ the wiki#
+ .
+ |]
+
+main :: IO ()
+main = do
+ app <- App <$> newWiki
+ warpDebug 3000 app
diff --git a/demo/Wiki.hs b/demo/Wiki.hs
new file mode 100644
index 00000000..a7722c74
--- /dev/null
+++ b/demo/Wiki.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- | Define the dispatch for a Wiki. You should probably start off by reading
+-- WikiRoutes.
+module Wiki
+ ( module WikiRoutes
+ ) where
+
+import Control.Applicative ((<$>))
+import Control.Monad (unless)
+import Data.IORef.Lifted (readIORef, atomicModifyIORef)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Text (Text)
+import WikiRoutes
+import Yesod
+
+-- | A subsite needs to be an instance of YesodSubDispatch, which states how to
+-- dispatch. By using constraints, we can make requirements of our master site.
+-- In this example, we're saying that the master site must be an instance of
+-- YesodWiki.
+instance YesodWiki master => YesodSubDispatch Wiki (HandlerT master IO) where
+ -- | This is all the TH magic for dispatch. WikiRoutes provides the
+ -- resourcesWiki value automatically, and mkYesodSubDispatch will generate
+ -- a dispatch function that will call out to the appropriate handler
+ -- functions.
+ yesodSubDispatch = $(mkYesodSubDispatch resourcesWiki)
+
+-- | Helper type synonym to be used below.
+type WikiHandler a = forall master. YesodWiki master
+ => HandlerT Wiki (HandlerT master IO) a
+
+------------- Helper functions
+
+-- | Get all of the content in the Wiki.
+getContent :: WikiHandler (Map Texts Textarea)
+getContent = getYesod >>= readIORef . wikiContent
+
+-- | Put a single new value into the Wiki.
+putContent :: Texts -> Textarea -> WikiHandler ()
+putContent k v = do
+ refMap <- wikiContent <$> getYesod
+ atomicModifyIORef refMap $ \m -> (Map.insert k v m, ())
+
+-- | Gets the homepage, which lists all of the pages available.
+getWikiHomeR :: WikiHandler TypedContent
+getWikiHomeR = do
+ content <- getContent
+ -- We use the new selectRep/provideRep functionality to provide either an
+ -- HTML or JSON representation of the page. You could just as easily
+ -- provide YAML, plain text, RSS, or anything else.
+ selectRep $ do
+ provideRep $ do
+ -- We'll use toParent to convert Wiki routes into our master site
+ -- routes.
+ toParent <- getRouteToParent
+
+ -- Run the master site's defaultLayout to style the page.
+ lift $ defaultLayout
+ [whamlet|
+ This wiki has the following pages:
+
+ $forall page <- Map.keys content
+