From 5c5a080f0f0fea643bdd6af1f6e40d89d8b5b4d9 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 13 Feb 2019 16:32:45 +0100
Subject: [PATCH] Compile Sass

---
 package.yaml                          |  1 +
 src/Settings/StaticFiles.hs           |  3 +-
 src/Settings/StaticFiles/Generator.hs | 64 +++++++++++++++++++++++++++
 3 files changed, 67 insertions(+), 1 deletion(-)
 create mode 100644 src/Settings/StaticFiles/Generator.hs

diff --git a/package.yaml b/package.yaml
index 46af6eab8..0aadd7a3f 100644
--- a/package.yaml
+++ b/package.yaml
@@ -114,6 +114,7 @@ dependencies:
   - memcached-binary
   - directory-tree
   - lifted-base
+  - hsass
 
 other-extensions:
   - GeneralizedNewtypeDeriving
diff --git a/src/Settings/StaticFiles.hs b/src/Settings/StaticFiles.hs
index c7bd88255..d2375a8e5 100644
--- a/src/Settings/StaticFiles.hs
+++ b/src/Settings/StaticFiles.hs
@@ -6,6 +6,7 @@ module Settings.StaticFiles
 import ClassyPrelude
 
 import Settings     (appStaticDir, compileTimeAppSettings)
+import Settings.StaticFiles.Generator
 import Yesod.EmbeddedStatic
 
 -- This generates easy references to files in the static directory at compile time,
@@ -23,4 +24,4 @@ import Yesod.EmbeddedStatic
 #define DEV_BOOL False
 #endif
 
-mkEmbeddedStatic DEV_BOOL "embeddedStatic" [embedDir $ appStaticDir compileTimeAppSettings]
+mkEmbeddedStatic DEV_BOOL "embeddedStatic" . pure . staticGenerator $ appStaticDir compileTimeAppSettings
diff --git a/src/Settings/StaticFiles/Generator.hs b/src/Settings/StaticFiles/Generator.hs
new file mode 100644
index 000000000..e59e944ed
--- /dev/null
+++ b/src/Settings/StaticFiles/Generator.hs
@@ -0,0 +1,64 @@
+module Settings.StaticFiles.Generator
+  ( staticGenerator
+  ) where
+
+import ClassyPrelude
+import Yesod.EmbeddedStatic.Types
+import Yesod.EmbeddedStatic
+
+import System.FilePath
+import System.Directory.Tree
+import Network.Mime
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+
+import qualified Data.Map as Map
+
+import qualified Text.Sass.Compilation as Sass
+
+import Data.Default
+
+import qualified Data.Foldable as Fold
+
+
+staticGenerator :: FilePath -> Generator
+staticGenerator staticDir = do
+  dirTree' <- runIO $ readDirectoryWith toEntries staticDir
+  Fold.forM_ (fst <$> zipPaths dirTree') addDependentFile
+  return . Fold.fold $ dirTree dirTree'
+  where
+    toEntries :: FilePath -- ^ Absolute path
+              -> IO [Entry]
+    toEntries loc = compile (mimeByExt mimeMap defaultMimeType $ pack loc) (makeRelative staticDir loc) loc 
+
+    mimeMap = defaultMimeMap `mappend` Map.fromList
+      [ ("sass", "text/x-sass")
+      , ("scss", "text/x-scss")
+      ]
+
+compile :: MimeType
+        -> Location -- ^ Relative location
+        -> FilePath -- ^ Absolute filepath
+        -> IO [Entry]
+compile sassMime sassLoc fp
+  | sassMime `elem` [ "text/x-sass", "text/x-scss" ]
+  = return . pure $ def
+    { ebHaskellName = Just $ pathToName ebLocation
+    , ebLocation
+    , ebMimeType = "text/css"
+    , ebProductionContent = either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile fp def
+    , ebDevelReload = [| either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile $(litE $ stringL fp) def |]
+    }
+  where
+    ebLocation = sassLoc -<.> "css"
+compile ebMimeType ebLocation fp = return . pure $ def
+  { ebHaskellName = Just $ pathToName ebLocation
+  , ebLocation
+  , ebMimeType
+  , ebProductionContent = LBS.fromStrict <$> BS.readFile fp
+  , ebDevelReload = [| LBS.fromStrict <$> BS.readFile $(litE $ stringL fp) |]
+  }