summaryrefslogtreecommitdiff
path: root/Biz/Bild.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Bild.hs')
-rw-r--r--Biz/Bild.hs151
1 files changed, 128 insertions, 23 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 565792e..7e67b8d 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -1,4 +1,6 @@
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | A general purpose build tool.
@@ -7,41 +9,144 @@
-- - for a dev build, results are stored in _bild/dev/<target>
module Biz.Bild where
-import Alpha
+import Alpha hiding ((<.>), sym)
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Text as Text
import qualified System.Directory as Dir
import qualified System.Environment as Env
import qualified System.Exit as Exit
-import System.FilePath ((</>))
+import System.FilePath ((<.>), (</>))
import qualified System.Process as Process
+import Text.Regex.Applicative
+import qualified Prelude
main :: IO ()
main = Env.getArgs /> head >>= \case
- Nothing -> do
- basename <- Env.getProgName
- Exit.die <| "usage: " <> basename <> " <target>"
- Just target -> nixBuild target
+ Nothing -> Exit.die "usage: bild <target>"
+ Just target -> analyze target >>= build
-{-
-TODO:
-- parse target syntax
-- write dev builder for ghc/ghcjs
--}
+type Namespace = String
-type Target = String
+type Dep = String
-nixBuild :: Target -> IO ()
-nixBuild target = do
+type Exe = String
+
+data Compiler = Ghc | Ghcjs | Nix
+ deriving (Show)
+
+data Target
+ = Target
+ { -- | Output executable name
+ exe :: Exe,
+ -- | Fully qualified namespace partitioned by '.'
+ namespace :: Namespace,
+ -- | Absolute path to file
+ path :: FilePath,
+ -- | Parsed/detected dependencies
+ deps :: [Dep],
+ -- | Which compiler should we use?
+ compiler :: Compiler
+ }
+ deriving (Show)
+
+analyze :: String -> IO Target
+analyze s = do
root <- Env.getEnv "BIZ_ROOT"
cwd <- Dir.getCurrentDirectory
- let qualifiedTarget = reps root "" cwd <> target
- Process.callProcess
- "nix-build"
- [ "-o",
- root </> "_bild/nix" </> qualifiedTarget,
- root </> "default.nix",
- "--attr",
- qualifiedTarget
- ]
+ -- this is a hack to support multiple file types. Ideally we would just detect
+ -- which file extensions exist
+ let path = cwd </> reps "." "/" s |> reps "/hs" ".hs" |> reps "/nix" ".nix"
+ content <- lines </ Prelude.readFile path
+ let exe = content /> match metaExe |> catMaybes |> head |> require "exe"
+ return
+ Target
+ { namespace =
+ require "namespace"
+ <| path
+ |> reps root ""
+ |> reps ".hs" ""
+ |> reps ".nix" ""
+ |> reps "/" "."
+ |> List.stripPrefix "."
+ >>= match metaNamespace,
+ deps = content /> match metaDep |> catMaybes,
+ compiler =
+ if ".hs" `List.isSuffixOf` path
+ then if ".js" `List.isSuffixOf` exe then Ghcjs else Ghc
+ else Nix,
+ ..
+ }
+
+build :: Target -> IO ()
+build Target {..} = do
+ root <- Env.getEnv "BIZ_ROOT"
+ case compiler of
+ Ghc -> do
+ putText <| "bild: ghc: " <> Text.pack namespace
+ let out = root </> "_bild/dev/bin"
+ Dir.createDirectoryIfMissing True out
+ Process.callProcess
+ "ghc"
+ [ "-Werror",
+ "-i" <> root,
+ "-odir",
+ root </> "_bild/int",
+ "-hidir",
+ root </> "_bild/int",
+ "--make",
+ path,
+ "-main-is",
+ namespace,
+ "-o",
+ out </> exe
+ ]
+ Ghcjs -> do
+ putText <| "bild: ghcjs: " <> Text.pack namespace
+ let out = root </> "_bild/dev/static"
+ Dir.createDirectoryIfMissing True out
+ Process.callProcess
+ "ghcjs"
+ [ "-Werror",
+ "-i" <> root,
+ "-odir",
+ root </> "_bild/int",
+ "-hidir",
+ root </> "_bild/int",
+ "--make",
+ path,
+ "-main-is",
+ namespace,
+ "-o",
+ out </> exe
+ ]
+ Nix -> do
+ putText <| "bild: nix: " <> Text.pack namespace
+ cwd <- Dir.getCurrentDirectory
+ let qualifiedTarget = reps root "" cwd <> namespace
+ Process.callProcess
+ "nix-build"
+ [ "-o",
+ root </> "_bild/nix" </> qualifiedTarget,
+ root </> "default.nix",
+ "--attr",
+ qualifiedTarget
+ ]
+
+metaNamespace :: RE Char Namespace
+metaNamespace = name <> many (sym '.') <> name
+ where
+ name = many (psym Char.isUpper) <> many (psym Char.isLower)
+
+metaDep :: RE Char Dep
+metaDep = string "-- : dep " *> many (psym Char.isAlpha)
+
+metaExe :: RE Char Exe
+metaExe = string "-- : exe " *> many (psym (/= ' '))
+
+require :: Text -> Maybe a -> a
+require s (Just x) = x
+require s Nothing = panic <| s <> " not found"
-- | Replace 'a' in 's' with 'b'.
reps :: String -> String -> String -> String