From d01ae63e93088d0576606302d5887e965e7e7ac6 Mon Sep 17 00:00:00 2001
From: Ignat Insarov <kindaro@gmail.com>
Date: Thu, 9 Feb 2023 12:31:41 +0300
Subject: [PATCH] Add tokenizing minifier.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Ideally we should prefer a minifier that calls for GHC to parse the file
and then define a custom printer for GHC's internal representation. But
for now this.
---
 minify.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100755 minify.hs

diff --git a/minify.hs b/minify.hs
new file mode 100755
index 0000000..9255ac5
--- /dev/null
+++ b/minify.hs
@@ -0,0 +1,66 @@
+#!/usr/bin/env -S runghc-9.2.4 -XUnicodeSyntax -XBlockArguments
+
+import Data.Char
+import Data.List
+import System.Environment
+import System.Exit
+import System.FilePath
+
+overlay function list =
+  let pairs = fmap function (zip list (tail list))
+   in (fst . head) pairs : fmap snd pairs
+
+specialTokens =
+  [ "("
+  , ","
+  , ")"
+  , "{"
+  , ";"
+  , "}"
+  , "["
+  , "]"
+  , "←"
+  , "→"
+  , "<-"
+  , "->"
+  , "∷"
+  , "::"
+  , "@"
+  , "\\"
+  ]
+
+isAllowedInName = or . flip fmap [isAlphaNum, (== '_'), (== '\'')] . flip ($)
+
+addWhiteRoom = overlay \(this, next) →
+  if this `elem` specialTokens
+    then (this, next)
+    else
+      if (isAllowedInName . last) this && (isAllowedInName . head) next
+        then (this, " " <> next)
+        else (this, next)
+
+cut fit list = (last . filter (fit . fst)) (zipWith splitAt [0 ..] (replicate (length list + 1) list))
+
+main = do
+  target ← fmap (!! 0) getArgs
+  if takeExtension target /= ".hs"
+    then exitFailure
+    else tailor target
+
+tailor target = do
+  cloth ← readFile target
+  let
+    (snowflakes, leftovers) = cut (all \line → (head line == '#')) (lines cloth)
+    tokens = words (unlines leftovers)
+    tokensWithWhiteRoom = addWhiteRoom tokens
+    cuts = flip
+      unfoldr
+      tokensWithWhiteRoom
+      \tokens →
+        if null tokens
+          then Nothing
+          else let (chunk, leftovers) = cut (\chunk → sum (fmap length chunk) <= 80) tokens in Just (concat chunk, leftovers)
+    shirt = unlines snowflakes <> unlines cuts
+  if shirt == cloth
+    then exitSuccess
+    else writeFile (replaceExtension target ".minified.hs") shirt