1 files changed, 15 insertions, 59 deletions

diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index c1cd24f..c55693d 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -119,6 +119,8 @@
 module Biz.Bild where
 
 import Alpha hiding (sym, (<.>))
+import Biz.Namespace (Namespace)
+import qualified Biz.Namespace as Namespace
 import qualified Data.Char as Char
 import qualified Data.List as List
 import qualified Data.String as String
@@ -127,7 +129,6 @@ import qualified System.Console.Docopt as Docopt
 import qualified System.Directory as Dir
 import qualified System.Environment as Env
 import System.FilePath ((</>))
-import qualified System.FilePath as File
 import qualified System.Process as Process
 import qualified Text.Regex.Applicative as Regex
 import qualified Prelude
@@ -151,12 +152,6 @@ Options:
   -v, --verbose    Show output from underlying compiler
 |]
 
-data Ext = Hs | Scm | Nix
-  deriving (Show)
-
-data Namespace = Namespace [String] Ext
-  deriving (Show)
-
 type Dep = String
 
 type Out = String
@@ -187,14 +182,10 @@ analyze s = do
   host <- chomp </ readFile "/etc/hostname"
   cwd <- Dir.getCurrentDirectory
   let path = cwd </> s
-      namespace =
-        require "namespace"
-          <| path
-          |> reps root ""
-          |> List.stripPrefix "/"
-          >>= Regex.match metaNamespace
-  case File.takeExtension path of
-    ".hs" -> do
+  let namespace@(Namespace.Namespace _ ext) =
+        require "namespace" <| Namespace.fromPath root path
+  case ext of
+    Namespace.Hs -> do
       content <- String.lines </ Prelude.readFile path
       let out = content /> Regex.match metaOut |> catMaybes |> head |> require "out"
       let compiler = if ".js" `List.isSuffixOf` out then Ghcjs else Ghc
@@ -204,7 +195,7 @@ analyze s = do
             builder = user <> "@localhost",
             ..
           }
-    ".nix" ->
+    Namespace.Nix ->
       return
         Target
           { deps = [],
@@ -223,7 +214,7 @@ analyze s = do
                     ],
             ..
           }
-    ".scm" ->
+    Namespace.Scm ->
       return
         Target
           { deps = [],
@@ -232,14 +223,13 @@ analyze s = do
             builder = user <> "@localhost",
             ..
           }
-    e -> panic <| "bild does not know this extension: " <> Text.pack e
 
 build :: Target -> IO ()
 build target@Target {..} = do
   root <- Env.getEnv "BIZ_ROOT"
   case compiler of
     Ghc -> do
-      putText <| "bild: dev: ghc: " <> nsToPath namespace
+      putText <| "bild: dev: ghc: " <> Namespace.toPath namespace
       let outDir = root </> "_/bild/dev/bin"
       Dir.createDirectoryIfMissing True outDir
       putText <| "bild: dev: local: " <> Text.pack builder
@@ -254,12 +244,12 @@ build target@Target {..} = do
           "--make",
           path,
           "-main-is",
-          nsToHaskellModule namespace,
+          Namespace.toHaskellModule namespace,
           "-o",
           outDir </> out
         ]
     Ghcjs -> do
-      putText <| "bild: dev: ghcjs: " <> nsToPath namespace
+      putText <| "bild: dev: ghcjs: " <> Namespace.toPath namespace
       let outDir = root </> "_/bild/dev/static"
       Dir.createDirectoryIfMissing True outDir
       putText <| "bild: dev: local: " <> Text.pack builder
@@ -274,17 +264,17 @@ build target@Target {..} = do
           "--make",
           path,
           "-main-is",
-          nsToHaskellModule namespace,
+          Namespace.toHaskellModule namespace,
           "-o",
           outDir </> out
         ]
     Guile -> do
-      putText <| "bild: dev: guile: " <> nsToPath namespace
+      putText <| "bild: dev: guile: " <> Namespace.toPath namespace
       putText <| "bild: dev: local: " <> Text.pack builder
       putText "bild: guile TODO"
       putText <| show target
     NixBuild -> do
-      putText <| "bild: nix: " <> nsToPath namespace
+      putText <| "bild: nix: " <> Namespace.toPath namespace
       let outDir = root </> "_/bild/nix"
       Dir.createDirectoryIfMissing True outDir
       putText <| "bild: nix: remote: " <> Text.pack builder
@@ -292,7 +282,7 @@ build target@Target {..} = do
         "nix-build"
         [ path,
           "-o",
-          outDir </> (Text.unpack <| nsToPath namespace),
+          outDir </> (Text.unpack <| Namespace.toPath namespace),
           -- Set default arguments to nix functions
           "--arg",
           "bild",
@@ -310,42 +300,8 @@ build target@Target {..} = do
           builder
         ]
 
-nsToHaskellModule :: Namespace -> String
-nsToHaskellModule (Namespace parts Hs) = joinWith "." parts
-nsToHaskellModule (Namespace _ ext) =
-  panic <| "can't convert " <> show ext <> " to a Haskell module"
-
-nsToPath :: Namespace -> Text
-nsToPath (Namespace parts ext) =
-  Text.pack
-    <| joinWith "/" parts
-    <> "."
-    <> lowercase (show ext)
-
-metaNamespace :: Regex.RE Char Namespace
-metaNamespace = 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"
-
 metaDep :: Regex.RE Char Dep
 metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha)
 
 metaOut :: Regex.RE Char Out
 metaOut = Regex.string "-- : out " *> Regex.many (Regex.psym (/= ' '))
-
--- | Replace 'a' in 's' with 'b'.
-reps :: String -> String -> String -> String
-reps a b s@(x : xs) =
-  if isPrefixOf a s
-    then -- then, write 'b' and replace jumping 'a' substring
-      b ++ reps a b (drop (length a) s)
-    else -- then, write 'x' char and try to replace tail string
-      x : reps a b xs
-reps _ _ [] = []