src/site.hs: Fix compiler warnings about unused modules/redundant imports

guix.scm

@@ -21,16 +21,43 @@
  ((guix licenses) #:prefix license:)
  (guix packages)
  (guix build-system haskell)
+ (gnu packages base)
  (rekahsoft-gnu packages haskell-web))
 
+(define release-version "0.0.0.0")
+
 (define-public blog-rekahsoft-ca
   (package
     (name "blog-rekahsoft-ca")
-    (version "0.0.0-0")
+    (version release-version)
-    (source #f)
+    (source (string-append "./dist/blog-rekahsoft-ca-" release-version ".tar.gz"))
     (build-system haskell-build-system)
+    (native-inputs `(("glibc-utf8-locales" ,glibc-utf8-locales)))
     (inputs `(("ghc-hakyll" ,ghc-hakyll)
               ("ghc-clay" ,ghc-clay)))
+    (outputs `("out" "site" "static"))
+    (arguments
+     `(#:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'install-site-script
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (setenv "PATH" (string-append out "/bin:" (getenv "PATH")))
+               (install-file "site" (string-append out "/bin/"))
+               #t)))
+         (add-after 'install-site-script 'build-site
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (site (assoc-ref outputs "site")))
+               (setenv "LANG" "en_US.UTF-8")
+
+               ;; For some reason, all files are read-only and need to be adjusted to allow the
+               ;; site to be generated
+               (for-each make-file-writable (find-files "."))
+
+               (invoke "site" "build")
+               (copy-recursively "_site" site)
+               #t))))))
     (home-page "http://git.rekahsoft.ca/rekahsoft/blog-rekahsoft-ca")
     (synopsis "Code, templates and content for my Hakyll powered blog at blog.rekahsoft.ca")
     (description

manifest.scm

@@ -25,6 +25,8 @@
 
 (load "guix.scm")
 
+(setenv "PS1" "\\W [env]\\$ ")
+
 (define dev-transform
   (options->transformation
    `((with-source . ,(string-append "blog-rekahsoft-ca=" (getcwd))))))
@@ -34,5 +36,4 @@
   (packages->manifest
    `(,(dev-transform blog-rekahsoft-ca)))
   (specifications->manifest
-   `("coreutils"
+   `("coreutils"))))
-     "glibc-utf8-locales"))))

src/site.hs

@@ -24,15 +24,10 @@
 
 import Hakyll
 import Control.Monad
-import Data.Monoid (mconcat,(<>))
 import Data.List (sortBy)
-import Data.Map (toList)
 import Data.Ord (comparing)
-import System.Random
 import System.FilePath (takeBaseName)
 import System.Process
-import System.Exit
-import System.IO (hGetContents)
 
 import Text.Parsec
 import Text.Pandoc.Options
@@ -96,166 +91,162 @@ myConfig = defaultConfiguration
         }
 
 main :: IO ()
-main = do
+main = hakyllWith myConfig $ do
-  -- Get a random number generator before going into Rules monad
+  match ("action/**" .||. "files/**" .||. "images/**" .||. "fonts/**" .||. "robots.txt") $ do
-  stdGen <- getStdGen
+    route   idRoute
+    compile copyFileCompiler
 
-  hakyllWith myConfig $ do
+  match "css/**" $ do
-    match ("action/**" .||. "files/**" .||. "images/**" .||. "fonts/**" .||. "robots.txt") $ do
+    route   idRoute
-      route   idRoute
+    compile compressCssCompiler
-      compile copyFileCompiler
 
-    match "css/**" $ do
+  match "lib/Skeleton/*.css" $ do
-      route   idRoute
+    route   $ gsubRoute "Skeleton" (const "css")
-      compile compressCssCompiler
+    compile compressCssCompiler
 
-    match "lib/Skeleton/*.css" $ do
+  match "templates/**" $ compile $ getResourceBody >>= saveSnapshot "original"
-      route   $ gsubRoute "Skeleton" (const "css")
+    >> templateCompiler
-      compile compressCssCompiler
 
-    match "templates/**" $ compile $ getResourceBody >>= saveSnapshot "original"
+  -- Generate tags
-      >> templateCompiler
+  tags <- buildTags ("posts/**" .&&. hasNoVersion) (fromCapture "tags/*1.html")
 
-    -- Generate tags
+  -- Generate paginate
-    tags <- buildTags ("posts/**" .&&. hasNoVersion) (fromCapture "tags/*1.html")
+  paginatedPosts <- buildPaginateWith
+                    (fmap (paginateEvery numPaginatePages) . sortRecentFirst)
+                    ("posts/**" .&&. hasNoVersion)
+                    (\n -> fromCapture "blog*.html" (show n))
 
-    -- Generate paginate
+  clayDeps <- makePatternDependency $ fromGlob "clay/**.hs"
-    paginatedPosts <- buildPaginateWith
-                      (fmap (paginateEvery numPaginatePages) . sortRecentFirst)
-                      ("posts/**" .&&. hasNoVersion)
-                      (\n -> fromCapture "blog*.html" (show n))
 
-    clayDeps <- makePatternDependency $ fromGlob "clay/**.hs"
+  rulesExtraDependencies [clayDeps] $ create ["default.css"] $ do
+    route     idRoute
+    compile $ makeItem =<< (unsafeCompiler $ readProcess "gencss" ["compact"] "")
 
-    rulesExtraDependencies [clayDeps] $ create ["default.css"] $ do
+  match "css/**" $ do
-      route     idRoute
+    route   idRoute
-      compile $ makeItem =<< (unsafeCompiler $ readProcess "gencss" ["compact"] "")
+    compile compressCssCompiler
 
-    match "css/**" $ do
+  match "lib/Skeleton/*.css" $ do
-      route   idRoute
+    route   $ gsubRoute "Skeleton" (const "css")
-      compile compressCssCompiler
+    compile compressCssCompiler
 
-    match "lib/Skeleton/*.css" $ do
+  match "templates/**" $ compile $ getResourceBody >>= saveSnapshot "original"
-      route   $ gsubRoute "Skeleton" (const "css")
+    >> templateCompiler
-      compile compressCssCompiler
 
-    match "templates/**" $ compile $ getResourceBody >>= saveSnapshot "original"
+  -- Generate tag pages
-      >> templateCompiler
+  forM_ (tagsMap tags) $ \(tag, identifiers) -> do
+    paginatedTaggedPosts <- buildPaginateWith
+                            (fmap (paginateEvery numPaginatePages) . sortRecentFirst)
+                            (fromList identifiers)
+                            (\n -> fromCapture (fromGlob $ "tags/" ++ tag ++ "*.html") (show n))
 
-    -- Generate tag pages
+    paginateRules paginatedTaggedPosts $ \pageNum pattern -> do
-    forM_ (tagsMap tags) $ \(tag, identifiers) -> do
+      route   $ gsubRoute " " (const "-") `composeRoutes` setExtension "html"
-      paginatedTaggedPosts <- buildPaginateWith
-                              (fmap (paginateEvery numPaginatePages) . sortRecentFirst)
-                              (fromList identifiers)
-                              (\n -> fromCapture (fromGlob $ "tags/" ++ tag ++ "*.html") (show n))
-
-      paginateRules paginatedTaggedPosts $ \pageNum pattern -> do
-        route   $ gsubRoute " " (const "-") `composeRoutes` setExtension "html"
-        compile $ do
-          posts <- recentFirst =<< loadAllSnapshots pattern "content"
-
-          navCtx <- genNavContext "pages/blog.markdown"
-
-          let ctx = taggedPostCtx tags                                    <>
-                    paginateContext paginatedTaggedPosts pageNum          <>
-                    constField "tag" tag                                  <>
-                    listField "posts" (taggedPostCtx tags) (return posts)
-              indexCtx = if pageNum <= 2
-                         then appCacheCtx <> navCtx
-                         else navCtx
-
-          makeItem ""
-            >>= loadAndApplyTemplate "templates/tag-page.html" ctx
-            >>= loadAndApplyTemplate "templates/default.html" indexCtx
-
-      rulesExtraDependencies [tagsDependency tags] $ do
-        create [fromFilePath $ "tags/" ++ tag ++ ".xml"] $ do
-          route   $ gsubRoute " " (const "-") `composeRoutes` setExtension "xml"
-          compile $ loadAllSnapshots (fromList identifiers) "content"
-            >>= fmap (take 10) . recentFirst
-            >>= renderAtom (feedConfiguration $ Just tag) (bodyField "description" <> defaultContext)
-
-    let pageRoute = gsubRoute "pages/" (const "") `composeRoutes` setExtension "html"
-
-    match ("pages/*" .&&. complement "pages/blog.markdown") $ version "nav-gen" $ do
-      route   $ pageRoute
-      compile $ pandocCompiler
-
-    match "pages/blog.markdown" $ version "nav-gen" $ do
-      route   $ constRoute "blog1.html"
-      compile $ pandocCompiler
-
-    paginateRules paginatedPosts $ \pageNum pattern -> do
-      route idRoute
       compile $ do
         posts <- recentFirst =<< loadAllSnapshots pattern "content"
 
         navCtx <- genNavContext "pages/blog.markdown"
 
         let ctx = taggedPostCtx tags                                    <>
-                  paginateContext paginatedPosts pageNum                <>
+                  paginateContext paginatedTaggedPosts pageNum          <>
+                  constField "tag" tag                                  <>
                   listField "posts" (taggedPostCtx tags) (return posts)
             indexCtx = if pageNum <= 2
                        then appCacheCtx <> navCtx
                        else navCtx
 
         makeItem ""
-          >>= loadAndApplyTemplate "templates/pages/blog.html" ctx
+          >>= loadAndApplyTemplate "templates/tag-page.html" ctx
           >>= loadAndApplyTemplate "templates/default.html" indexCtx
 
-    match ("pages/*" .&&. complement "pages/blog.markdown") $ do
+    rulesExtraDependencies [tagsDependency tags] $ do
-      route   $ pageRoute
+      create [fromFilePath $ "tags/" ++ tag ++ ".xml"] $ do
-      compile $ do
+        route   $ gsubRoute " " (const "-") `composeRoutes` setExtension "xml"
-        posts <- recentFirst =<< loadAllSnapshots "posts/**" "content"
+        compile $ loadAllSnapshots (fromList identifiers) "content"
+          >>= fmap (take 10) . recentFirst
+          >>= renderAtom (feedConfiguration $ Just tag) (bodyField "description" <> defaultContext)
 
-        -- Get the current Identifier
+  let pageRoute = gsubRoute "pages/" (const "") `composeRoutes` setExtension "html"
-        curId <- getUnderlying
 
-        let pageFilePath = toFilePath curId
+  match ("pages/*" .&&. complement "pages/blog.markdown") $ version "nav-gen" $ do
-            pageName     = takeBaseName pageFilePath
+    route   $ pageRoute
-            recentPosts  = take 5 posts
+    compile $ pandocCompiler
-            pageTemplate = "templates/pages/" ++ pageName ++ ".html"
 
-        -- Generate navigation context
+  match "pages/blog.markdown" $ version "nav-gen" $ do
-        navCtx <- genNavContext pageFilePath
+    route   $ constRoute "blog1.html"
+    compile $ pandocCompiler
 
-        let masterCtx =
+  paginateRules paginatedPosts $ \pageNum pattern -> do
-              listField "recentPosts" (taggedPostCtx tags) (return recentPosts) <>
+    route idRoute
-              listField "posts" (taggedPostCtx tags) (return posts)             <>
+    compile $ do
-              tagCloudField "tagCloud" 65 135 tags                              <>
+      posts <- recentFirst =<< loadAllSnapshots pattern "content"
-              defaultContext
-            indexCtx = navCtx <> appCacheCtx
 
-        sectionCtx <- getResourceBody >>= genSectionContext
+      navCtx <- genNavContext "pages/blog.markdown"
-        pg <- loadSnapshot (fromFilePath pageTemplate) "original"
-          >>= applyAsTemplate (sectionCtx <> masterCtx)
 
-        (makeItem . itemBody) pg
+      let ctx = taggedPostCtx tags                                    <>
-          >>= loadAndApplyTemplate "templates/default.html" indexCtx
+                paginateContext paginatedPosts pageNum                <>
+                listField "posts" (taggedPostCtx tags) (return posts)
+          indexCtx = if pageNum <= 2
+                     then appCacheCtx <> navCtx
+                     else navCtx
 
-    match "posts/**" $ do
+      makeItem ""
-      route   $ setExtension "html"
+        >>= loadAndApplyTemplate "templates/pages/blog.html" ctx
-      compile $ do
+        >>= loadAndApplyTemplate "templates/default.html" indexCtx
-        indexCtx <- genNavContext "pages/blog.markdown"
 
-        pandocCompilerWith pandocReaderOptions pandocWriterOptions
+  match ("pages/*" .&&. complement "pages/blog.markdown") $ do
-          >>= saveSnapshot "content"
+    route   $ pageRoute
-          >>= loadAndApplyTemplate "templates/partials/post.html" (taggedPostCtx tags)
+    compile $ do
-          >>= loadAndApplyTemplate "templates/default.html" indexCtx
+      posts <- recentFirst =<< loadAllSnapshots "posts/**" "content"
 
-    create ["atom.xml"] $ do
+      -- Get the current Identifier
-      route   idRoute
+      curId <- getUnderlying
-      compile $ do
-        let feedCtx = postCtx <> bodyField "description"
-        blogPosts <- loadAllSnapshots ("posts/**" .&&. hasNoVersion) "content"
-                       >>= fmap (take 10) . recentFirst
-        renderAtom (feedConfiguration Nothing) feedCtx blogPosts
 
-    forM_ [("js/**", idRoute),
+      let pageFilePath = toFilePath curId
-           ("lib/JQuery/*", gsubRoute "JQuery" $ const "js")] $ \(p, r) ->
+          pageName     = takeBaseName pageFilePath
-      match p $ do
+          recentPosts  = take 5 posts
-          route   r
+          pageTemplate = "templates/pages/" ++ pageName ++ ".html"
-          compile $ copyFileCompiler
+
+      -- Generate navigation context
+      navCtx <- genNavContext pageFilePath
+
+      let masterCtx =
+            listField "recentPosts" (taggedPostCtx tags) (return recentPosts) <>
+            listField "posts" (taggedPostCtx tags) (return posts)             <>
+            tagCloudField "tagCloud" 65 135 tags                              <>
+            defaultContext
+          indexCtx = navCtx <> appCacheCtx
+
+      sectionCtx <- getResourceBody >>= genSectionContext
+      pg <- loadSnapshot (fromFilePath pageTemplate) "original"
+        >>= applyAsTemplate (sectionCtx <> masterCtx)
+
+      (makeItem . itemBody) pg
+        >>= loadAndApplyTemplate "templates/default.html" indexCtx
+
+  match "posts/**" $ do
+    route   $ setExtension "html"
+    compile $ do
+      indexCtx <- genNavContext "pages/blog.markdown"
+
+      pandocCompilerWith pandocReaderOptions pandocWriterOptions
+        >>= saveSnapshot "content"
+        >>= loadAndApplyTemplate "templates/partials/post.html" (taggedPostCtx tags)
+        >>= loadAndApplyTemplate "templates/default.html" indexCtx
+
+  create ["atom.xml"] $ do
+    route   idRoute
+    compile $ do
+      let feedCtx = postCtx <> bodyField "description"
+      blogPosts <- loadAllSnapshots ("posts/**" .&&. hasNoVersion) "content"
+                     >>= fmap (take 10) . recentFirst
+      renderAtom (feedConfiguration Nothing) feedCtx blogPosts
+
+  forM_ [("js/**", idRoute),
+         ("lib/JQuery/*", gsubRoute "JQuery" $ const "js")] $ \(p, r) ->
+    match p $ do
+        route   r
+        compile $ copyFileCompiler
 
 ---------------------------------------------------------------------------------------------------------
 -- Functions & Constants --------------------------------------------------------------------------------