Add Biz.Namespace library

1 files changed, 54 insertions, 0 deletions

diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
new file mode 100644
index 0000000..48ae1e6
--- /dev/null
+++ b/Biz/Namespace.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Biz.Namespace
+  ( Namespace (..),
+    Ext (..),
+    fromPath,
+    toPath,
+    toHaskellModule,
+    match,
+  )
+where
+
+import Alpha
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Text.Regex.Applicative as Regex
+
+data Ext = Hs | Scm | Nix
+  deriving (Show)
+
+data Namespace = Namespace [String] Ext
+  deriving (Show)
+
+match :: String -> Maybe Namespace
+match = Regex.match <| Namespace </ path <* Regex.sym '.' <*> ext
+  where
+    name =
+      Regex.many (Regex.psym Char.isUpper)
+        <> Regex.many (Regex.psym Char.isLower)
+    path = Regex.many (name <* Regex.string "/" <|> name)
+    ext =
+      Nix <$ Regex.string "nix"
+        <|> Hs <$ Regex.string "hs"
+        <|> Scm <$ Regex.string "scm"
+
+fromPath :: String -> String -> Maybe Namespace
+fromPath bizRoot absPath =
+  List.stripPrefix bizRoot absPath
+    >>= List.stripPrefix "/"
+    >>= match
+
+toHaskellModule :: Namespace -> String
+toHaskellModule (Namespace parts Hs) = joinWith "." parts
+toHaskellModule (Namespace _ ext) =
+  panic <| "can't convert " <> show ext <> " to a Haskell module"
+
+toPath :: Namespace -> Text
+toPath (Namespace parts ext) =
+  Text.pack
+    <| joinWith "/" parts
+    <> "."
+    <> lowercase (show ext)