Add WebsiteContent #48

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.

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 {..}

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

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

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

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

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)