diff options
Diffstat (limited to 'Biz')
| -rw-r--r-- | Biz/Bild.hs | 141 | ||||
| -rw-r--r-- | Biz/Bild/Deps/Haskell.nix | 1 | ||||
| -rw-r--r-- | Biz/Bild/Rules.nix | 26 | ||||
| -rw-r--r-- | Biz/Bild/ShellHook.sh | 67 | ||||
| -rw-r--r-- | Biz/Cloud/Git.nix | 2 | ||||
| -rw-r--r-- | Biz/Dev/Configuration.nix | 2 | ||||
| -rw-r--r-- | Biz/Keys/Ben.key (renamed from Biz/Keys/Ben.pub) | 0 | ||||
| -rw-r--r-- | Biz/Keys/Deploy.key (renamed from Biz/Keys/Deploy.pub) | 0 | ||||
| -rw-r--r-- | Biz/Keys/Nick.key (renamed from Biz/Keys/Nick.pub) | 0 | ||||
| -rwxr-xr-x | Biz/Lint.py | 8 | ||||
| -rw-r--r-- | Biz/Namespace.hs | 21 | ||||
| -rw-r--r-- | Biz/Users.nix | 8 |
12 files changed, 169 insertions, 107 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 23086a7..96f63ad 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -6,12 +6,9 @@ -- | A general purpose build tool. -- --- Not all of the below design is implemented. Currently: --- --- - with a nix build, results are linked in _/bild/nix/<target> --- - with a dev build, results are stored in _/bild/dev/<target> --- --- ----------------------------------------------------------------------------- +-- : out bild +-- : dep docopt +-- : dep regex-applicative -- -- == Design constraints -- @@ -119,7 +116,7 @@ module Biz.Bild where import Alpha hiding (sym, (<.>)) -import Biz.Namespace (Namespace) +import Biz.Namespace (Namespace (..)) import qualified Biz.Namespace as Namespace import qualified Data.Char as Char import qualified Data.List as List @@ -137,8 +134,11 @@ main :: IO () main = Env.getArgs >>= Docopt.parseArgsOrExit help >>= run where run args = - Docopt.getAllArgs args (Docopt.argument "target") - |> mapM_ (\target -> analyze target >>= build) + mapM getNamespace (Docopt.getAllArgs args (Docopt.argument "target")) + /> catMaybes + /> filter isBuildableNs + >>= mapM analyze + >>= mapM_ build help :: Docopt.Docopt help = @@ -156,7 +156,14 @@ type Dep = String type Out = String -data Compiler = Ghc | Ghcjs | Guile | NixBuild +data Compiler + = GhcLib + | GhcExe + | GhcjsLib + | GhcjsExe + | Guile + | NixBuild + | Copy deriving (Show) data Target = Target @@ -175,20 +182,42 @@ data Target = Target } deriving (Show) -analyze :: String -> IO Target -analyze s = do - user <- Env.getEnv "USER" +isBuildableNs :: Namespace -> Bool +isBuildableNs (Namespace _ Namespace.Hs) = True +isBuildableNs ns + | ns `elem` nixTargets = True + | otherwise = False + +nixTargets :: [Namespace] +nixTargets = + [ Namespace ["Biz", "Pie"] Namespace.Nix, + Namespace ["Biz", "Que", "Prod"] Namespace.Nix, + Namespace ["Biz", "Cloud"] Namespace.Nix, + Namespace ["Biz", "Dev"] Namespace.Nix, + Namespace ["Hero", "Prod"] Namespace.Nix + ] + +getNamespace :: String -> IO (Maybe Namespace) +getNamespace s = do root <- Env.getEnv "BIZ_ROOT" - host <- chomp </ readFile "/etc/hostname" cwd <- Dir.getCurrentDirectory - let path = cwd </> s - let namespace@(Namespace.Namespace _ ext) = - require "namespace" <| Namespace.fromPath root path + return <| Namespace.fromPath root <| cwd </> s + +analyze :: Namespace -> IO Target +analyze namespace@(Namespace.Namespace _ ext) = do + user <- Env.getEnv "USER" + host <- chomp </ readFile "/etc/hostname" + let path = Namespace.toPath namespace 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 + let out = + content + /> Regex.match metaOut + |> catMaybes + |> head + |> fromMaybe mempty + let compiler = detectGhcCompiler out <| String.unlines content return Target { deps = content /> Regex.match metaDep |> catMaybes, @@ -223,13 +252,41 @@ analyze s = do builder = user <> "@localhost", .. } + _ -> + return + Target + { deps = [], + compiler = Copy, + out = "", + builder = user <> "@localhost", + .. + } + +-- | Some rules for detecting the how to compile a ghc module. If there is an +-- out, then we know it's some Exe; if the out ends in .js then it's GhcjsExe, +-- otherwise GhcExe. That part is solved. +-- +-- Detecting a Lib is harder, and much code can be compiled by both ghc and +-- ghcjs. For now I'm just guarding against known ghcjs-only modules in the +-- import list. +detectGhcCompiler :: String -> String -> Compiler +detectGhcCompiler out _ | jsSuffix out = GhcjsExe +detectGhcCompiler out _ | not <| jsSuffix out || null out = GhcExe +detectGhcCompiler _ content + | match "import GHCJS" = GhcjsLib + | otherwise = GhcLib + where + match s = s `List.isInfixOf` content + +jsSuffix :: String -> Bool +jsSuffix = List.isSuffixOf ".js" build :: Target -> IO () build target@Target {..} = do root <- Env.getEnv "BIZ_ROOT" case compiler of - Ghc -> do - putText <| "bild: dev: ghc: " <> Namespace.toPath namespace + GhcExe -> do + putStrLn <| "bild: dev: ghc-exe: " <> Namespace.toPath namespace let outDir = root </> "_/bild/dev/bin" Dir.createDirectoryIfMissing True outDir putText <| "bild: dev: bilder: " <> Text.pack builder @@ -248,8 +305,22 @@ build target@Target {..} = do "-o", outDir </> out ] - Ghcjs -> do - putText <| "bild: dev: ghcjs: " <> Namespace.toPath namespace + GhcLib -> do + putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace + putText <| "bild: dev: bilder: " <> Text.pack builder + Process.callProcess + "ghc" + [ "-Werror", + "-i" <> root, + "-odir", + root </> "_/bild/int", + "-hidir", + root </> "_/bild/int", + "--make", + path + ] + GhcjsExe -> do + putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace let outDir = root </> "_/bild/dev/static" Dir.createDirectoryIfMissing True outDir putText <| "bild: dev: local: " <> Text.pack builder @@ -268,13 +339,27 @@ build target@Target {..} = do "-o", outDir </> out ] + GhcjsLib -> do + putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace + putText <| "bild: dev: local: " <> Text.pack builder + Process.callProcess + "ghcjs" + [ "-Werror", + "-i" <> root, + "-odir", + root </> "_/bild/int", + "-hidir", + root </> "_/bild/int", + "--make", + path + ] Guile -> do - putText <| "bild: dev: guile: " <> Namespace.toPath namespace + putStrLn <| "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: " <> Namespace.toPath namespace + putStrLn <| "bild: nix: " <> Namespace.toPath namespace let outDir = root </> "_/bild/nix" Dir.createDirectoryIfMissing True outDir if null builder @@ -284,7 +369,7 @@ build target@Target {..} = do "nix-build" [ path, "-o", - outDir </> (Text.unpack <| Namespace.toPath namespace), + outDir </> Namespace.toPath namespace, -- Set default arguments to nix functions "--arg", "bild", @@ -300,6 +385,10 @@ build target@Target {..} = do "--builders", builder ] + Copy -> do + putStrLn <| "bild: copy: " <> Namespace.toPath namespace + putText "bild: copy TODO" + putText <| show target metaDep :: Regex.RE Char Dep metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha) diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix index 001cdb2..dc33483 100644 --- a/Biz/Bild/Deps/Haskell.nix +++ b/Biz/Bild/Deps/Haskell.nix @@ -3,6 +3,7 @@ with hpkgs; [ MonadRandom QuickCheck + SafeSemaphore acid-state aeson async diff --git a/Biz/Bild/Rules.nix b/Biz/Bild/Rules.nix index 9a7ad77..be9fa31 100644 --- a/Biz/Bild/Rules.nix +++ b/Biz/Bild/Rules.nix @@ -77,7 +77,7 @@ in rec { ghcjs = main: let data = analyze main; - ghcjs = mkGhcjsPackageSet (hp: selectAttrs data.dep hp); + ghcjs = mkGhcjsPackageSet (hp: selectAttrs data.deps hp); in stdenv.mkDerivation { name = data.module; src = ../../.; @@ -105,18 +105,18 @@ in rec { # haskell deps (mkGhcPackageSet haskellDeps) # ghcjs doesn't need everything, and many things fail to build - (mkGhcjsPackageSet [ - "aeson" - "clay" - "containers" - "miso" - "protolude" - "servant" - "split" - "string-quote" - "text" - "ghcjs-base" - ]) + (mkGhcjsPackageSet (hp: with hp; [ + aeson + clay + containers + miso + protolude + servant + split + string-quote + text + ghcjs-base + ])) # scheme deps nixpkgs.guile diff --git a/Biz/Bild/ShellHook.sh b/Biz/Bild/ShellHook.sh index e83973e..e307e04 100644 --- a/Biz/Bild/ShellHook.sh +++ b/Biz/Bild/ShellHook.sh @@ -7,7 +7,6 @@ function help() { echo " deps manage dependencies with niv" echo " ghci start ghci with correct options" echo " help show this message" - echo " hero compile and start a dev server for herocomics.app" echo " lint auto-lint all changed files" echo " pie product improvement engine" echo " push send a namespace to the cloud" @@ -34,28 +33,6 @@ function deps() { alias ghci="ghci -i$BIZ_ROOT -ghci-script $BIZ_ROOT/.ghci" -function hero() { - export HERO_PORT=3000 - export HERO_KEEP=$BIZ_ROOT/_/keep - export HERO_SKEY=$BIZ_ROOT/_/skey - bild="runghc Biz.Bild" - if [[ ! -z "${IN_NIX_SHELL}" ]] - then - out="_/bild/dev" - # in dev mode, mmc.js is a directory of js assets - export HERO_NODE=$BIZ_ROOT/$out/static/mmc.js - rg --files \ - | entr -rcs \ - "$bild Hero.Host.hs && $bild Hero.Node.hs && $out/bin/mmc" - else - out="_/bild/nix" - export HERO_NODE=$BIZ_ROOT/$out/Hero.Node/static - rg --files \ - | entr -rcs \ - "$bild Hero.Host && $bild Hero.Node && $out/Hero.Host/bin/mmc" - fi -} - alias lint=$BIZ_ROOT/Biz/Lint.py function pie() { @@ -73,6 +50,7 @@ function push() { else target="$prefix.$1" fi + echo "push: $target" what=$(realpath "$BIZ_ROOT/_/bild/nix/$target") # hack: get the domain from the activation script. there does not seem # to be a way to get it from nix-instantiate @@ -84,21 +62,18 @@ function push() { # TODO: convert to haskell function ship() { - $BIZ_ROOT/Biz/Lint.py - stuff=(${1}) + lint + stuff=(${@}) if [[ ${#stuff[@]} -eq 0 ]] then stuff=( - Biz.Cloud - Biz.Dev - Que.Prod - Hero.Prod + Biz/Cloud.nix + Biz/Dev.nix + Biz/Que/Prod.nix + Hero/Prod.nix ) fi - for thing in ${stuff[@]} - do - bild $thing - done + bild ${stuff[@]} for thing in ${stuff[@]} do push $thing @@ -106,27 +81,11 @@ function ship() { } # Poor man's ci -function ci() { - set -e - lint **/* - stuff=( - Biz/Pie.hs - Biz/Pie.nix - Biz/Devalloc.hs - Biz/Que/Site.hs - Biz/Que/Host.hs - Biz/Que/Prod.nix - Biz/Cloud.nix - Biz/Dev.nix - Hero/Host.hs - Hero/Node.hs - Hero/Prod.nix - ) - for thing in ${stuff[@]} - do - bild "$thing" - done - set +e +function run-ci() { + lint **/* && bild **/* } +alias ci="time run-ci" + +export PS1='\n$(printf "%3.*s" $? $?)> ' help diff --git a/Biz/Cloud/Git.nix b/Biz/Cloud/Git.nix index 6104ced..82761ce 100644 --- a/Biz/Cloud/Git.nix +++ b/Biz/Cloud/Git.nix @@ -11,7 +11,7 @@ extraGitoliteRc = '' $RC{SITE_INFO} = 'a computer is a bicycle for the mind.'; ''; - adminPubkey = builtins.readFile ../Keys/Ben.pub; + adminPubkey = builtins.readFile ../Keys/Ben.key; }; }; } diff --git a/Biz/Dev/Configuration.nix b/Biz/Dev/Configuration.nix index 13be1be..0986131 100644 --- a/Biz/Dev/Configuration.nix +++ b/Biz/Dev/Configuration.nix @@ -247,7 +247,7 @@ in { sshServe = { enable = true; keys = [ - (builtins.readFile ../Keys/Ben.pub) + (builtins.readFile ../Keys/Ben.key) ]; }; trustedUsers = [ "root" "ben" ]; diff --git a/Biz/Keys/Ben.pub b/Biz/Keys/Ben.key index c661508..c661508 100644 --- a/Biz/Keys/Ben.pub +++ b/Biz/Keys/Ben.key diff --git a/Biz/Keys/Deploy.pub b/Biz/Keys/Deploy.key index 664a2d9..664a2d9 100644 --- a/Biz/Keys/Deploy.pub +++ b/Biz/Keys/Deploy.key diff --git a/Biz/Keys/Nick.pub b/Biz/Keys/Nick.key index 4dc08fb..4dc08fb 100644 --- a/Biz/Keys/Nick.pub +++ b/Biz/Keys/Nick.key diff --git a/Biz/Lint.py b/Biz/Lint.py index fc035cb..c3e51df 100755 --- a/Biz/Lint.py +++ b/Biz/Lint.py @@ -89,12 +89,20 @@ if __name__ == "__main__": else: FILES = group_files(sys.argv[1:], [".hs", ".py"]) for hs in FILES[".hs"]: + if not os.path.exists(hs): + print("lint: does not exist:", hs) + continue print(f"lint: {hs}") run("ormolu", hs) run("hlint", hs) for py in FILES[".py"]: + if not os.path.exists(py): + print("lint: does not exist:", py) + continue print(f"lint: {py}") # Broken in our nixpkgs # run("black", py) run("pylint", py) + if ERRORS: + print("lint: errors:", ERRORS) sys.exit(ERRORS) diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs index 48ae1e6..574a2fc 100644 --- a/Biz/Namespace.hs +++ b/Biz/Namespace.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} +-- : dep regex-applicative module Biz.Namespace ( Namespace (..), Ext (..), @@ -14,26 +15,31 @@ 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 Ext = Hs | Scm | Nix | Md | Css | Py | Sh | Key | Json | None + deriving (Eq, Show) data Namespace = Namespace [String] Ext - deriving (Show) + deriving (Eq, 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) + <> Regex.many (Regex.psym Char.isAlphaNum) path = Regex.many (name <* Regex.string "/" <|> name) ext = Nix <$ Regex.string "nix" <|> Hs <$ Regex.string "hs" <|> Scm <$ Regex.string "scm" + <|> Md <$ Regex.string "md" + <|> Css <$ Regex.string "css" + <|> Py <$ Regex.string "py" + <|> Sh <$ Regex.string "sh" + <|> Key <$ Regex.string "key" + <|> Json <$ Regex.string "json" fromPath :: String -> String -> Maybe Namespace fromPath bizRoot absPath = @@ -46,9 +52,8 @@ toHaskellModule (Namespace parts Hs) = joinWith "." parts toHaskellModule (Namespace _ ext) = panic <| "can't convert " <> show ext <> " to a Haskell module" -toPath :: Namespace -> Text +toPath :: Namespace -> FilePath toPath (Namespace parts ext) = - Text.pack - <| joinWith "/" parts + joinWith "/" parts <> "." <> lowercase (show ext) diff --git a/Biz/Users.nix b/Biz/Users.nix index 8a804ca..0f68b50 100644 --- a/Biz/Users.nix +++ b/Biz/Users.nix @@ -14,20 +14,20 @@ deploy = { isNormalUser = true; home = "/home/deploy"; - openssh.authorizedKeys.keyFiles = [ ./Keys/Deploy.pub ]; + openssh.authorizedKeys.keyFiles = [ ./Keys/Deploy.key ]; extraGroups = [ "wheel" ]; }; # # humans # - root.openssh.authorizedKeys.keyFiles = [ ./Keys/Ben.pub ]; + root.openssh.authorizedKeys.keyFiles = [ ./Keys/Ben.key ]; root.password = "erewhon"; ben = { description = "Ben Sima"; isNormalUser = true; home = "/home/ben"; - openssh.authorizedKeys.keyFiles = [ ./Keys/Ben.pub ]; + openssh.authorizedKeys.keyFiles = [ ./Keys/Ben.key ]; extraGroups = [ "wheel" "docker" ]; hashedPassword = "$6$SGhdoRB6DhWe$elW8RQE1ebe8JKf1ALW8jGZTPCyn2rpq/0J8MV/A9y8qFMEhA.Z2eiexMgptohZAK5kcGOc6HIUgNzJqnDUvY."; @@ -36,7 +36,7 @@ description = "Nick Sima"; isNormalUser = true; home = "/home/nick"; - openssh.authorizedKeys.keyFiles = [ ./Keys/Nick.pub ]; + openssh.authorizedKeys.keyFiles = [ ./Keys/Nick.key ]; extraGroups = [ "docker" ]; }; }; |