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