From 968805f01ffac3182f194a4a431eda84ce202f11 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 9 Dec 2014 14:01:38 +0200 Subject: [PATCH] Add WebsiteContent #48 --- Application.hs | 15 +++++++++++++++ Data/WebsiteContent.hs | 17 +++++++++++++++++ Foundation.hs | 3 +++ Handler/Home.hs | 5 ++++- Import.hs | 1 + config/routes | 1 + stackage-server.cabal | 2 ++ 7 files changed, 43 insertions(+), 1 deletion(-) create mode 100644 Data/WebsiteContent.hs diff --git a/Application.hs b/Application.hs index e353347..7969eba 100644 --- a/Application.hs +++ b/Application.hs @@ -13,6 +13,7 @@ import Control.Monad.Logger (runLoggingT, LoggingT, defaultLogStr) import Data.BlobStore (fileStore, storeWrite, cachedS3Store) import Data.Hackage import Data.Hackage.Views +import Data.WebsiteContent import Data.Slug (SnapSlug (..), safeMakeSlug, HasGenIO) import Data.Time (diffUTCTime) import qualified Database.Esqueleto as E @@ -33,11 +34,13 @@ import Yesod.Core.Types (loggerSet, Logger (Logger)) import Yesod.Default.Config import Yesod.Default.Handlers import Yesod.Default.Main +import Yesod.GitRepo (gitRepo) import System.Environment (getEnvironment) import Data.BlobStore (HasBlobStore (..), BlobStore) import System.IO (hSetBuffering, BufferMode (LineBuffering)) import qualified Data.ByteString as S import qualified Data.Text as T +import System.Process (rawSystem) import qualified Echo @@ -163,6 +166,17 @@ makeFoundation useEcho conf = do (statusRef, unpacker) <- createHaddockUnpacker haddockRootDir' blobStore' widgetCache' <- newIORef mempty + when development $ void $ rawSystem "git" + [ "clone" + , "https://github.com/fpco/stackage-content.git" + ] + websiteContent' <- gitRepo + (if development + then "stackage-content" + else "https://github.com/fpco/stackage-content.git") + "master" + loadWebsiteContent + let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App { settings = conf @@ -179,6 +193,7 @@ makeFoundation useEcho conf = do , haddockUnpacker = unpacker , widgetCache = widgetCache' , compressorStatus = statusRef + , websiteContent = websiteContent' } -- Perform database migration using our application's logging settings. diff --git a/Data/WebsiteContent.hs b/Data/WebsiteContent.hs new file mode 100644 index 0000000..2f38958 --- /dev/null +++ b/Data/WebsiteContent.hs @@ -0,0 +1,17 @@ +module Data.WebsiteContent + ( WebsiteContent (..) + , loadWebsiteContent + ) where + +import ClassyPrelude.Yesod +import Text.Blaze.Html (preEscapedToMarkup) + +data WebsiteContent = WebsiteContent + { wcHomepage :: !Html + } + +loadWebsiteContent :: FilePath -> IO WebsiteContent +loadWebsiteContent dir = do + wcHomepage <- fmap (preEscapedToMarkup :: Text -> Html) + $ readFile $ dir "homepage.html" + return WebsiteContent {..} diff --git a/Foundation.hs b/Foundation.hs index 11b2ed6..b1df6e2 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -3,6 +3,7 @@ module Foundation where import ClassyPrelude.Yesod import Data.BlobStore import Data.Slug (safeMakeSlug, HasGenIO (getGenIO), randomSlug, Slug, SnapSlug) +import Data.WebsiteContent import qualified Database.Persist import Model import qualified Settings @@ -19,6 +20,7 @@ import Yesod.Auth.GoogleEmail2 import Yesod.Core.Types (Logger, GWData) import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) +import Yesod.GitRepo -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -43,6 +45,7 @@ data App = App -- unpack job. , widgetCache :: !(IORef (HashMap Text (UTCTime, GWData (Route App)))) , compressorStatus :: !(IORef Text) + , websiteContent :: GitRepo WebsiteContent } type ForceUnpack = Bool diff --git a/Handler/Home.hs b/Handler/Home.hs index 0c63bc2..635890b 100644 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -4,6 +4,7 @@ module Handler.Home where import Data.Slug import Database.Esqueleto as E hiding (isNothing) import Import hiding ((=.),on,(||.),(==.)) +import Yesod.GitRepo (grContent) -- This is a handler function for the G request method on the HomeR -- resource pattern. All of your resource patterns are defined in @@ -16,13 +17,15 @@ getHomeR :: Handler Html getHomeR = do windowsLatest <- linkFor "unstable-ghc78hp-inclusive" restLatest <- linkFor "unstable-ghc78-inclusive" + homepage <- getYesod >>= fmap wcHomepage . liftIO . grContent . websiteContent defaultLayout $ do setTitle "Stackage Server" $(combineStylesheets 'StaticR [ css_bootstrap_modified_css , css_bootstrap_responsive_modified_css ]) - $(widgetFile "homepage") + toWidget homepage + -- $(widgetFile "homepage") where linkFor name = do slug <- mkSlug name diff --git a/Import.hs b/Import.hs index 297d04d..d796420 100644 --- a/Import.hs +++ b/Import.hs @@ -11,6 +11,7 @@ import Settings.StaticFiles as Import import Types as Import import Yesod.Auth as Import import Data.Slug (mkSlug) +import Data.WebsiteContent as Import (WebsiteContent (..)) requireAuthIdOrToken :: Handler UserId requireAuthIdOrToken = do diff --git a/config/routes b/config/routes index 69aa115..65e11a5 100644 --- a/config/routes +++ b/config/routes @@ -1,5 +1,6 @@ /static StaticR Static getStatic /auth AuthR Auth getAuth +/reload WebsiteContentR GitRepo-WebsiteContent websiteContent /favicon.ico FaviconR GET /robots.txt RobotsR GET diff --git a/stackage-server.cabal b/stackage-server.cabal index 9f57e60..9be6e4a 100644 --- a/stackage-server.cabal +++ b/stackage-server.cabal @@ -26,6 +26,7 @@ library Data.BlobStore Data.Hackage Data.Hackage.Views + Data.WebsiteContent Types Handler.Home Handler.Snapshots @@ -146,6 +147,7 @@ library , formatting , blaze-html , haddock-library + , yesod-gitrepo executable stackage-server if flag(library-only)