Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Multiple versions of the book

  • Loading branch information...
commit 3789dc43d114e5b3229b423c89c0fcdd46d4133e 1 parent bef548d
@snoyberg snoyberg authored
View
1  .gitignore
@@ -4,3 +4,4 @@ dist/
static/tmp/
tmp
config/client_session_key.aes
+content-1.1/
View
74 Application.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances #-}
module Application
( getApplication
, getApplicationDev
@@ -11,6 +12,7 @@ import Yesod.Default.Main
import Yesod.Default.Handlers
import Network.Wai.Middleware.Gzip
import Network.Wai.Middleware.Autohead
+import Book.Routes
#if DEVELOPMENT
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
#else
@@ -21,11 +23,13 @@ import Data.IORef (newIORef, writeIORef)
import System.Process (runProcess, waitForProcess)
import Yesod.Static (Static (Static))
import Network.Wai.Application.Static (defaultFileServerSettings)
-import Control.Monad (unless, forever)
+import Control.Monad (unless, forever, forM_)
import Filesystem (isDirectory)
import System.Process (rawSystem)
import System.Exit (ExitCode (ExitSuccess), exitWith)
import Control.Concurrent (forkIO, threadDelay)
+import qualified Filesystem.Path.CurrentOS as F
+import qualified Data.Text as T
-- Import all relevant handler modules here.
import Handler.Root
@@ -34,6 +38,9 @@ import Handler.Page
import Handler.Blog
import Handler.Book
+instance YesodSubDispatch BookSub (HandlerT YesodWeb IO) where
+ yesodSubDispatch = $(mkYesodSubDispatch resourcesBookSub)
+
-- This line actually creates our YesodSite instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see
-- the comments there for more details.
@@ -45,23 +52,39 @@ mkYesodDispatch "YesodWeb" resourcesYesodWeb
-- migrations handled by Yesod.
getApplication :: AppConfig DefaultEnv Extra -> IO Application
getApplication conf = do
- exists <- isDirectory "content"
- unless exists $ do
- putStrLn "Cloning content"
- ec <- rawSystem "git" ["clone", "https://github.com/yesodweb/yesodweb.com-content.git", "content"]
- unless (ec == ExitSuccess) $ do
- putStrLn "git clone failed, exiting"
- exitWith ec
+ forM_ branches $ \(dir, branch) -> do
+ exists <- isDirectory $ F.decodeString dir
+ unless exists $ do
+ putStrLn $ "Cloning " ++ dir
+ ec <- rawSystem "git"
+ [ "clone"
+ , "-b"
+ , branch
+ , "https://github.com/yesodweb/yesodweb.com-content.git"
+ , dir
+ ]
+ unless (ec == ExitSuccess) $ do
+ putStrLn "git clone failed, exiting"
+ exitWith ec
s <- staticSite
let assets = Static $ defaultFileServerSettings "content/static"
mblog <- loadBlog
iblog <- newIORef $ fromMaybe (error "Invalid posts.yaml") mblog
- ibook <- loadBook >>= newIORef
+ booksub12 <- mkBookSub "Yesod Web Framework Book- Version 1.2 (beta)" "Note: This version of the book is not yet complete" $ F.decodeString dirCurrent
+ booksub11 <- mkBookSub "Yesod Web Framework Book- Version 1.1" "" $ F.decodeString dir11
iauthors <- loadAuthors >>= newIORef
- let foundation = YesodWeb conf s assets iblog ibook iauthors
+ let foundation = YesodWeb
+ { settings = conf
+ , getStatic = s
+ , getAssets = assets
+ , ywBlog = iblog
+ , ywAuthors = iauthors
+ , getBook12 = booksub12
+ , getBook11 = booksub11
+ }
app <- toWaiApp foundation
return $ gzip def
$ autohead
@@ -74,24 +97,45 @@ getApplication conf = do
logWare = logStdout
#endif
+mkBookSub :: Html -> Text -> F.FilePath -> IO BookSub
+mkBookSub title warning root = do
+ ibook <- loadBook (root F.</> "book") >>= newIORef
+ return BookSub
+ { bsRoot = root
+ , bsBook = ibook
+ , bsReload = loadBook root >>= writeIORef ibook
+ , bsTitle = title
+ , bsWarning = if T.null warning then Nothing else Just (toHtml warning)
+ }
+
-- for yesod devel
getApplicationDev :: IO (Int, Application)
getApplicationDev =
defaultDevelApp loader getApplication
where
- loader = loadConfig (configSettings Development)
+ loader = Yesod.Default.Config.loadConfig (configSettings Development)
{ csParseExtra = parseExtra
}
+dirCurrent = "content"
+dir11 = "content-1.1"
+
+branches =
+ [ (dirCurrent, "master")
+ , (dir11, "version1.1")
+ ]
+
postReloadR :: Handler ()
postReloadR = do
- let run x y = liftIO $ runProcess x y (Just "content") Nothing Nothing Nothing Nothing >>= waitForProcess >> return ()
- run "git" ["fetch"]
- run "git" ["checkout", "origin/master"]
+ forM_ branches $ \(dir, branch) -> do
+ let run x y = liftIO $ runProcess x y (Just dir) Nothing Nothing Nothing Nothing >>= waitForProcess >> return ()
+ run "git" ["fetch"]
+ run "git" ["checkout", "origin/" ++ branch]
yw <- getYesod
mblog <- liftIO loadBlog
case mblog of
Nothing -> return ()
Just blog -> liftIO $ writeIORef (ywBlog yw) blog
- liftIO $ loadBook >>= writeIORef (ywBook yw)
+ liftIO $ bsReload $ getBook12 yw
+ liftIO $ bsReload $ getBook11 yw
liftIO $ loadAuthors >>= writeIORef (ywAuthors yw)
View
22 Book/Routes.hs
@@ -0,0 +1,22 @@
+module Book.Routes where
+
+import Prelude (IO, Maybe)
+import Yesod
+import Data.Text (Text)
+import Data.IORef (IORef)
+import Book (Book)
+import Filesystem.Path (FilePath)
+
+data BookSub = BookSub
+ { bsBook :: IORef Book
+ , bsRoot :: FilePath
+ , bsReload :: IO ()
+ , bsTitle :: Html
+ , bsWarning :: Maybe Html
+ }
+
+mkYesodSubData "BookSub" [parseRoutes|
+/ BookHomeR GET
+/#Text ChapterR GET
+/image/#Text BookImageR GET
+|]
View
4 Foundation.hs
@@ -16,6 +16,7 @@ module Foundation
import Prelude
import Blog
import Book
+import Book.Routes
import Yesod hiding (Route)
import Yesod.AtomFeed (atomLink)
import Yesod.Static
@@ -40,8 +41,9 @@ data YesodWeb = YesodWeb
, getStatic :: Static -- ^ Settings for static file serving.
, getAssets :: Static
, ywBlog :: IORef Blog
- , ywBook :: IORef Book
, ywAuthors :: IORef (Map Text Settings.Author)
+ , getBook12 :: BookSub
+ , getBook11 :: BookSub
}
-- This is where we define all of the routes in our application. For a full
View
2  Handler/Blog.hs
@@ -42,7 +42,7 @@ getBlogPostR y m s = do
setTitle $ toHtml $ postTitle post
let rev :: Ord k => Map.Map k v -> [(k, v)]
rev = reverse . sortBy (comparing fst) . Map.toList
- $(widgetFile "blog")
+ $(widgetFile "blog") :: Widget
$(widgetFile "archive")
where
pretty 1 = "January"
View
37 Handler/Book.hs
@@ -1,5 +1,5 @@
module Handler.Book
- ( getBookR
+ ( getBookHomeR
, getChapterR
, getBookImageR
) where
@@ -7,7 +7,6 @@ module Handler.Book
import Import
import qualified Data.Text as T
import qualified Filesystem.Path.CurrentOS as F
-import Settings (bookRoot)
import Book
import qualified Data.Map as Map
import Text.XML
@@ -15,31 +14,41 @@ import Control.Monad (guard)
import Data.Maybe (fromMaybe)
import Network.HTTP.Types (status301)
import Data.IORef (readIORef)
+import Book.Routes
-getBookR :: Handler RepHtml
-getBookR = do
- ibook <- ywBook <$> getYesod
+getBookHomeR :: HandlerT BookSub Handler RepHtml
+getBookHomeR = do
+ bs <- getYesod
+ let ibook = bsBook bs
Book parts _ <- liftIO $ readIORef ibook
- defaultLayout $ do
- setTitle "Yesod Web Framework Book"
+ toMaster <- getRouteToParent
+ lift $ defaultLayout $ do
+ setTitle $ bsTitle bs
$(widgetFile "book")
$(widgetFile "booklist")
-getChapterR :: Text -> Handler RepHtml
+getChapterR :: Text -> HandlerT BookSub Handler RepHtml
getChapterR slug = do
- ibook <- ywBook <$> getYesod
+ bs <- getYesod
+ let ibook = bsBook bs
Book parts m <- liftIO $ readIORef ibook
chapter <- maybe notFound return $ Map.lookup slug m
- defaultLayout $ do
- setTitle $ toHtml $ chapterTitle chapter
+ toMaster <- getRouteToParent
+ lift $ defaultLayout $ do
+ setTitle $ mconcat
+ [ toHtml $ chapterTitle chapter
+ , " :: "
+ , bsTitle bs
+ ]
$(widgetFile "chapter")
$(widgetFile "booklist")
-getBookImageR :: Text -> Handler ()
+getBookImageR :: Text -> HandlerT BookSub Handler ()
getBookImageR name
- | name' == name'' =
+ | name' == name'' = do
+ bs <- getYesod
sendFile "image/png" $ F.encodeString $
- bookRoot F.</> "images" F.</> name' F.<.> "png"
+ bsRoot bs F.</> "images" F.</> name' F.<.> "png"
| otherwise = redirectWith status301 $ BookImageR $ either id id $ F.toText name'
where
name' = F.basename name''
View
6 Import.hs
@@ -31,7 +31,7 @@ import System.Locale (defaultTimeLocale)
import qualified Book
import qualified Filesystem.Path.CurrentOS as F
import qualified Data.Yaml
-import Settings (bookRoot, blogRoot, Author)
+import Settings (blogRoot, Author)
import Data.IORef (readIORef)
infixr 5 <>
@@ -66,8 +66,8 @@ getNewestBlog = do
prettyDay :: UTCTime -> String
prettyDay = formatTime defaultTimeLocale "%B %e, %Y"
-loadBook :: IO Book.Book
-loadBook = Book.loadBook $ bookRoot F.</> "yesod-web-framework-book.ditamap"
+loadBook :: F.FilePath -> IO Book.Book
+loadBook root = Book.loadBook $ root F.</> "yesod-web-framework-book.ditamap"
loadBlog :: IO (Maybe Blog)
loadBlog = Data.Yaml.decodeFile $ F.encodeString $ blogRoot F.</> "posts.yaml"
View
4 Settings.hs
@@ -10,7 +10,6 @@ module Settings
, Extra (..)
, parseExtra
, blogRoot
- , bookRoot
, Author (..)
) where
@@ -30,9 +29,6 @@ import Control.Monad (mzero)
blogRoot :: F.FilePath
blogRoot = "content/blog"
-bookRoot :: F.FilePath
-bookRoot = "content/book"
-
-- Static setting below. Changing these requires a recompile
-- | The location of static files on your system. This is a file system
View
6 config/routes
@@ -14,8 +14,8 @@
/blog BlogR GET
/blog/#Year/#Month/#Slug BlogPostR GET
-/book BookR GET
-/book/#Text ChapterR GET
-/book/image/#Text BookImageR GET
+/book BookR BookSub getBook11
+/book-1.1 Book11R BookSub getBook11
+/book-1.2 Book12R BookSub getBook12
/reload ReloadR POST
View
2  templates/blog.hamlet
@@ -10,7 +10,7 @@ $newline never
#{authorName author}
<p .github-link>
<a href="https://github.com/yesodweb/yesodweb.com-content/tree/master/blog/#{either id id $ F.toText $ postFP post}">View source on Github
- <div itemprop=description>^{toWidget content}
+ <div itemprop=description>^{content}
<h1 #comments>Comments
<div id="disqus_thread">
View
9 templates/book.hamlet
@@ -4,6 +4,13 @@
<div>
<a href="http://shop.oreilly.com/product/0636920023142.do">
<img src="http://akamaicovers.oreilly.com/images/0636920023142/cat.gif" alt="Developing Web Applications with Haskell and Yesod">
+
+ <p>
+ Note that the book is available for either
+ <a href=@{Book11R BookHomeR}>version 1.1
+ or
+ <a href=@{Book12R BookHomeR}>the 1.2 work-in-progress#
+ .
<h2> Chapters
<ul>
@@ -13,4 +20,4 @@
<ul>
$forall Chapter title _ slug _ <- chapters
<li>
- <a href=@{ChapterR slug}>#{title}
+ <a href=@{toMaster $ ChapterR slug}>#{title}
View
4 templates/booklist.hamlet
@@ -1,4 +1,6 @@
<section .getting-started>
+ $maybe w <- bsWarning bs
+ <p .warning>#{w}
<h2> Chapters
<ul>
$forall Part title chapters <- parts
@@ -7,4 +9,4 @@
<ul>
$forall Chapter title _ slug _ <- chapters
<li>
- <a href=@{ChapterR slug}>#{title}
+ <a href=@{toMaster $ ChapterR slug}>#{title}
View
4 templates/booklist.lucius
@@ -0,0 +1,4 @@
+.warning {
+ color: red;
+ font-weight: bold;
+}
View
2  templates/default-layout-wrapper.hamlet
@@ -31,7 +31,7 @@ $newline never
<li.googleplus>
<g:plusOne>
<li>
- <a href=@{BookR}>book
+ <a href=@{BookR BookHomeR}>book
<li>
<a href="https://github.com/yesodweb/yesod/wiki/Cookbook">cookbook
<li>
View
2  templates/homepage-wrapper.hamlet
@@ -31,7 +31,7 @@ $newline never
<li.googleplus>
<g:plusOne>
<li>
- <a href=@{BookR}>book
+ <a href=@{BookR BookHomeR}>book
<li>
<a href="https://github.com/yesodweb/yesod/wiki/Cookbook">cookbook
<li>
View
1  yesodweb.cabal
@@ -57,6 +57,7 @@ library
GADTs
GeneralizedNewtypeDeriving
FlexibleContexts
+ FlexibleInstances
PatternGuards
executable yesodweb
Please sign in to comment.
Something went wrong with that request. Please try again.