site.patch

commit 8b6907e3f4de964194bb6069b7053d0e62fe51f3
Author: Dmitry Moskowski <me@corpix.ru>
Date:   Sun Dec 10 01:33:47 2017 +0000

    Fighting with hakyll to implement a stupid menu

diff --git a/frontend.cabal b/frontend.cabal
index c1bb41f..500ccfa 100644
--- a/frontend.cabal
+++ b/frontend.cabal
@@ -5,9 +5,12 @@ cabal-version:      >= 1.10
 
 executable site
   main-is:          site.hs
-  build-depends:    base     == 4.*
-                  , hakyll   == 4.9.*
-                  , filepath >= 1.3   && < 1.5
-                  , time     >= 1.6   && < 1.9
+  build-depends:    base       == 4.*
+                  , hakyll     == 4.9.*
+                  , filepath   >= 1.3   && < 1.5
+                  , time       >= 1.6   && < 1.9
+                  , aeson      >= 1.1   && < 1.3
+                  , bytestring >= 0.10  && < 0.11
+                  , text       >= 1.2   && < 1.3
   ghc-options:      -threaded
   default-language: Haskell2010
diff --git a/menus/main.json b/menus/main.json
new file mode 100644
index 0000000..bb66fd5
--- /dev/null
+++ b/menus/main.json
@@ -0,0 +1,7 @@
+[
+    {
+        "title": "hell",
+        "image": "wat",
+        "url": "/"
+    }
+]
diff --git a/site.hs b/site.hs
index 16e864a..3fb3bd1 100644
--- a/site.hs
+++ b/site.hs
@@ -1,14 +1,43 @@
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE UnicodeSyntax     #-}
-import           Data.Monoid        (mappend)
-import           Data.Time.Calendar (toGregorian)
-import           Data.Time.Clock    (getCurrentTime, utctDay)
-import qualified GHC.IO.Encoding    as E
+import           Control.Applicative
+import           Data.Aeson
+import           Data.ByteString.Lazy as B
+import           Data.Maybe           (fromMaybe)
+import           Data.Monoid          ((<>))
+import           Data.Text            as T
+import           Data.Time.Calendar   (toGregorian)
+import           Data.Time.Clock      (getCurrentTime, utctDay)
+import           GHC.Generics
+import qualified GHC.IO.Encoding      as E
 import           Hakyll
-import           System.FilePath    (joinPath, replaceExtension, splitPath)
+import           Prelude              as P
+import           System.FilePath      (joinPath, replaceExtension, splitPath)
+
+data Menu =
+  Menu { title ∷ String
+       , image ∷ String
+       , url   ∷ String
+       } deriving (Show, Generic)
+
+instance FromJSON Menu
+instance ToJSON   Menu
+
+emptyContext ∷ Context String
+emptyContext = missingField
+
+menuFields ∷ Menu → Context String
+menuFields menu = constField "title" (title menu)
+                  <> constField "image" (image menu)
+                  <> constField "url" (url menu)
+                  <> emptyContext
+
+getMenu ∷ String → IO (Maybe [Menu])
+getMenu name = decode <$> B.readFile (name :: FilePath)
 
 dropPrefix ∷ String → String
-dropPrefix = joinPath . (drop 1) . splitPath
+dropPrefix = joinPath . (P.drop 1) . splitPath
 
 htmlExtension ∷ String → String
 htmlExtension = (`replaceExtension` "html")
@@ -21,6 +50,15 @@ main = do
   E.setLocaleEncoding E.utf8
 
   now <- getCurrentTime
+  mainMenu <- getMenu "menus/main.json"
+
+  let
+    (year, _, _) = toGregorian $ utctDay now
+    pageCtx =
+      (mconcat $ P.map menuFields $ fromMaybe [] mainMenu)
+      <> constField "year" (show year)
+      <> defaultContext
+
 
   hakyll $ do
     match (fromList ["robots.txt"] .||. fromGlob "images/*" .||. fromGlob "bundle/*") $ do
@@ -31,14 +69,7 @@ main = do
       route
         $ customRoute
         $ (dropPrefix . htmlExtension . toFilePath)
-      compile $ do
-        let
-          (year, _, _) = toGregorian $ utctDay now
-          pageCtx =
-            constField "year" (show year) `mappend`
-            defaultContext
-
-        pandocCompiler
+      compile $ pandocCompiler
           >>= loadAndApplyTemplate "templates/default.html" pageCtx
           >>= relativizeUrls