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.

1 files changed, 90 insertions, 0 deletions

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