From 846116c28c76cbca45601bd5304cabf0105288ba Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 26 Oct 2022 12:37:12 -0400
Subject: Factor out metadata handling into Biz.Bild.Meta

The code was becoming repetitive and messy, with functions like 'metaDep' and so
on. So that's an indication that they just need to have their own home.
---
 Biz/Bild/Meta.hs | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100644 Biz/Bild/Meta.hs

(limited to 'Biz/Bild')

diff --git a/Biz/Bild/Meta.hs b/Biz/Bild/Meta.hs
new file mode 100644
index 0000000..75242a5
--- /dev/null
+++ b/Biz/Bild/Meta.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Small module for extracting metadata from the comments of modules.
+module Biz.Bild.Meta where
+
+import Alpha
+import qualified Data.Aeson as Aeson
+import qualified Data.Char as Char
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Text.Regex.Applicative as Regex
+
+type Dep = String
+
+type Sys = String
+
+type Arg = String
+
+data Out = Lib String | Bin String | None
+  deriving (Show, Eq)
+
+instance Aeson.ToJSON Out where
+  toJSON =
+    Aeson.String <. Text.pack <. \case
+      Bin a -> a
+      Lib a -> a
+      None -> ""
+
+data Parsed = Parsed
+  { pdep :: Set Dep,
+    parg :: Set Arg,
+    pout :: Out,
+    psys :: Set Sys
+  }
+
+detect :: Ord a => Regex.RE Char a -> [Text] -> Set a
+detect m cl =
+  cl
+    /> Text.unpack
+    /> Regex.match m
+    |> catMaybes
+    |> Set.fromList
+
+-- | 'Out' is always singular, so it gets a special function
+detectOut :: Regex.RE Char Out -> [Text] -> Out
+detectOut m cl =
+  cl
+    /> Text.unpack
+    /> Regex.match m
+    |> catMaybes
+    |> head
+    |> fromMaybe None
+
+detectAll :: [Char] -> [Text] -> Parsed
+detectAll m cl = Parsed {..}
+  where
+    pout = detectOut (out m <|> lib m) cl
+    detect_ re = detect (re m) cl
+    pdep = detect_ dep
+    psys = detect_ sys
+    parg = detect_ arg
+
+dep :: [Char] -> Regex.RE Char Dep
+dep comment =
+  Regex.string (comment ++ " : dep ")
+    *> Regex.many (Regex.psym (not <. Char.isSpace))
+
+sys :: [Char] -> Regex.RE Char Dep
+sys comment =
+  Regex.string (comment ++ " : sys ")
+    *> Regex.many (Regex.psym (not <. Char.isSpace))
+
+out :: [Char] -> Regex.RE Char Out
+out comment =
+  Regex.string (comment ++ " : out ")
+    *> Regex.many (Regex.psym (/= ' '))
+    /> Bin
+
+lib :: [Char] -> Regex.RE Char Out
+lib comment =
+  Regex.string (comment ++ " : lib ")
+    *> Regex.many (Regex.psym (/= ' '))
+    /> Lib
+
+arg :: [Char] -> Regex.RE Char Arg
+arg comment =
+  Regex.string (comment ++ " : arg ")
+    *> Regex.many Regex.anySym
-- 
cgit v1.2.3