diff options
Diffstat (limited to 'Biz/Namespace.hs')
-rw-r--r-- | Biz/Namespace.hs | 54 |
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) |