From e7e44f8c63ff1ed1aa93e81b27cc9b5078cc71b7 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Wed, 2 Aug 2023 23:40:33 +0200
Subject: [PATCH] Add a development package for guix and fix SJW
 incompatibility since the 0.1.3.1 bugfix

---
 ghc-template.scm | 27 +++++++++++++++++++++++++++
 guix.scm         | 44 ++++++++++++++++++++++++++++++++++++++++++++
 src/JS.hs        |  7 ++++---
 3 files changed, 75 insertions(+), 3 deletions(-)
 create mode 100644 ghc-template.scm
 create mode 100644 guix.scm

diff --git a/ghc-template.scm b/ghc-template.scm
new file mode 100644
index 0000000..f766e41
--- /dev/null
+++ b/ghc-template.scm
@@ -0,0 +1,27 @@
+(use-modules (gnu packages haskell-xyz)
+             (gnu packages haskell-web)
+             (guix build-system haskell)
+             (guix download)
+             (guix gexp)
+             (guix git-download)
+             (guix licenses)
+             (guix packages))
+
+(package
+  (name "ghc-template")
+  (version "0.2.0.10")
+  (source (origin
+            (method url-fetch)
+            (uri (hackage-uri "template" version))
+            (sha256
+             (base32
+              "10mcnhi2rdflmv79z0359nn5sylifvk9ih38xnjqqby6n4hs7mcg"))))
+  (build-system haskell-build-system)
+  (properties '((upstream-name . "template")))
+  (home-page "http://hackage.haskell.org/package/template")
+  (synopsis "Simple string substitution")
+  (description
+   "Simple string substitution library that supports \\\"$\\\"-based substitution.
+Meant to be used when Text.Printf or string concatenation would lead to code
+that is hard to read but when a full blown templating system is overkill.")
+  (license bsd-3))
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..1466f8b
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,44 @@
+(use-modules (gnu packages haskell-xyz)
+             (gnu packages haskell-web)
+             (guix build-system haskell)
+             (guix download)
+             (guix gexp)
+             (guix git-download)
+             (guix licenses)
+             (guix packages)
+             (loom packages sjw))
+
+(let
+  ((%source-dir (dirname (current-filename)))
+   (ghc-template (load "ghc-template.scm")))
+  (package
+    (name "hablo")
+    (version "devel")
+    (source
+    (local-file %source-dir
+          #:recursive? #t
+          #:select? (git-predicate %source-dir)))
+    (build-system haskell-build-system)
+    (inputs
+      (list ghc-aeson
+            ghc-attoparsec
+            ghc-lucid
+            ghc-optparse-applicative
+            ghc-parsec
+            ghc-random
+            ghc-sjw
+            ghc-template
+            ghc-xdg-basedir))
+    (native-search-paths
+      (list
+        (search-path-specification (variable "SJW_PATH")
+                                   (files '("lib/SJW")))))
+    (home-page "https://git.marvid.fr/Tissevert/SJW")
+    (synopsis "The Simple Javascript Wrench")
+    (description
+     "SJW is a very simple tool to pack several JS modules into a single
+     script.  It doesn't really do proper compilation work (yet) except
+     resolving the modules dependencies and detecting import loops but it
+     provides each module with an independent execution context in the
+     resulting script.")
+    (license gpl3+)))
diff --git a/src/JS.hs b/src/JS.hs
index 757142d..2731c42 100644
--- a/src/JS.hs
+++ b/src/JS.hs
@@ -16,7 +16,7 @@ import Data.Text.Encoding (encodeUtf8)
 import JSON (exportBlog)
 import Paths_hablo (getDataDir)
 import Pretty ((.$))
-import SJW (compile, source, sourceCode)
+import SJW (compile, source)
 import System.Directory (createDirectoryIfMissing)
 import System.Exit (die)
 import System.FilePath ((</>))
@@ -45,10 +45,11 @@ generateConfig destinationDir = do
 generateMain :: FilePath -> IO ()
 generateMain destinationDir = do
   habloSources <- (</> "js") <$> getDataDir
-  result <- compile $ source [destinationDir, "unitJS", habloSources]
-  maybe (die "JS compilation failed\n") output =<< sourceCode result
+  compile (source [destinationDir, "unitJS", habloSources])
+    >>= either abort (output . fst)
   where
     output = writeFile (destinationDir </> "hablo.js") . fromStrict . encodeUtf8
+    abort = die . (<> "JS compilation failed\n")
 
 generate :: ReaderT Blog IO ()
 generate = do