From 9da4feb106126940264dd27925ea3c19b04aac20 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 30 Dec 2020 12:24:47 -0500 Subject: bild: build everyting Now bild knows how to determine between modules that require ghcjs and ghc. It also knows what *not* to build, meaning it won't try to build non-buildable nix targets, for example (unfortunately this is just hardcoded for now), but it also won't build scm or py targets that I haven't implemented yet. It just silently fails, which is fine, because it means I can do `bild **/*` and everything just works. Of course, if I want to build scm code then I will have to implement that, but that's not a priority right now. --- .ghci | 4 +- Biz/Bild.hs | 141 ++++++++++++++++++++++++++++++++++++--------- Biz/Bild/Deps/Haskell.nix | 1 + Biz/Bild/Rules.nix | 26 ++++----- Biz/Bild/ShellHook.sh | 67 +++++---------------- Biz/Cloud/Git.nix | 2 +- Biz/Dev/Configuration.nix | 2 +- Biz/Keys/Ben.key | 1 + Biz/Keys/Ben.pub | 1 - Biz/Keys/Deploy.key | 1 + Biz/Keys/Deploy.pub | 1 - Biz/Keys/Nick.key | 1 + Biz/Keys/Nick.pub | 1 - Biz/Lint.py | 8 +++ Biz/Namespace.hs | 21 ++++--- Biz/Users.nix | 8 +-- Control/Concurrent/Sema.hs | 3 + System/Random/Shuffle.hs | 7 ++- 18 files changed, 182 insertions(+), 114 deletions(-) create mode 100644 Biz/Keys/Ben.key delete mode 100644 Biz/Keys/Ben.pub create mode 100644 Biz/Keys/Deploy.key delete mode 100644 Biz/Keys/Deploy.pub create mode 100644 Biz/Keys/Nick.key delete mode 100644 Biz/Keys/Nick.pub diff --git a/.ghci b/.ghci index 3f7039a..65154ef 100644 --- a/.ghci +++ b/.ghci @@ -1,6 +1,6 @@ :set -XOverloadedStrings -:set prompt "λ " -:set prompt-cont "| " +:set prompt " λ " +:set prompt-cont " | " :set -Wall :set -haddock -- ':iq Module M' -> 'import qualified Module as M' 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/ --- - with a dev build, results are stored in _/bild/dev/ --- --- ----------------------------------------------------------------------------- +-- : 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 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 do content <- String.lines 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.key b/Biz/Keys/Ben.key new file mode 100644 index 0000000..c661508 --- /dev/null +++ b/Biz/Keys/Ben.key @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDDhmSEbvX6LSk1ZO/whhAWpxwUxGPwbn7ZKVmxLcIilLdkd/vhFQKSYyMBW+21G3cMbwyFVsCyPbADoXcvV5OSIklxgitP77/2TAgkEPjyklJ4KD0QNDjpu+YGGIyVTgE9YPBhpwuUlxRhux15vN8xzAXq4f5/xpyBPekIdbEaEUZHrKN/z9g8cgw9ZMWSrchbsE3QlU8MJK78HO+v3TjH7Ip+LffWNuhckiYnzT8Duy47vgc1OYqtJaDMN/ufK7yeNILK81M1ybHGOlqYxSfV/RM7oD0P5w5YeTXMpRsOyn4YVzhWSQFrlf08XbwlZUNm6Pb8eNRjM+3YyFTcUU/S81xKwOPRNNhlPnxz+tUltCR3H/0Falu1pxJYT2qfuM9j9z9xA1bJEsSSZ1b2bsHw7ujpRmg0xsPUk7DXIQ1Kh92BFfmDoZWeqsMF1E7H8iuaVsN9k96BwbBfiB4stQqI3ycuHO9zbsa12y8AQusDbr9W8rl/vR0pKNrcNO32ojOzkblJGWgyNxDvTS4l69+qi6pMBONicUUMQnXEtJoasjpECzwlAHIYJMmFQUuloEafR8b0ZAaCw+I5SfsyYF4hHLYseHvMavxgLNZ6W4ZlaL9XmQ7ZGhh10ub4ceW61QvCzKD34yO1yl8PcmS8Fa7bZbGxkq36oCusGbD65AlY+w== ben@lithium diff --git a/Biz/Keys/Ben.pub b/Biz/Keys/Ben.pub deleted file mode 100644 index c661508..0000000 --- a/Biz/Keys/Ben.pub +++ /dev/null @@ -1 +0,0 @@ -ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDDhmSEbvX6LSk1ZO/whhAWpxwUxGPwbn7ZKVmxLcIilLdkd/vhFQKSYyMBW+21G3cMbwyFVsCyPbADoXcvV5OSIklxgitP77/2TAgkEPjyklJ4KD0QNDjpu+YGGIyVTgE9YPBhpwuUlxRhux15vN8xzAXq4f5/xpyBPekIdbEaEUZHrKN/z9g8cgw9ZMWSrchbsE3QlU8MJK78HO+v3TjH7Ip+LffWNuhckiYnzT8Duy47vgc1OYqtJaDMN/ufK7yeNILK81M1ybHGOlqYxSfV/RM7oD0P5w5YeTXMpRsOyn4YVzhWSQFrlf08XbwlZUNm6Pb8eNRjM+3YyFTcUU/S81xKwOPRNNhlPnxz+tUltCR3H/0Falu1pxJYT2qfuM9j9z9xA1bJEsSSZ1b2bsHw7ujpRmg0xsPUk7DXIQ1Kh92BFfmDoZWeqsMF1E7H8iuaVsN9k96BwbBfiB4stQqI3ycuHO9zbsa12y8AQusDbr9W8rl/vR0pKNrcNO32ojOzkblJGWgyNxDvTS4l69+qi6pMBONicUUMQnXEtJoasjpECzwlAHIYJMmFQUuloEafR8b0ZAaCw+I5SfsyYF4hHLYseHvMavxgLNZ6W4ZlaL9XmQ7ZGhh10ub4ceW61QvCzKD34yO1yl8PcmS8Fa7bZbGxkq36oCusGbD65AlY+w== ben@lithium diff --git a/Biz/Keys/Deploy.key b/Biz/Keys/Deploy.key new file mode 100644 index 0000000..664a2d9 --- /dev/null +++ b/Biz/Keys/Deploy.key @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDlLRbbXgwjF7IqObf4dZE/jj0HoT6xJR6bP/6ZrJz7NPCPIgY3GacOtBfkJp6KK0zKQdFmxNpcfb3zgpe/Ru7pkmSfI9IoWAU3aLPWK2G3tbLPmktGmF9C53OhyXgFtBGr2Q/+wSRKAfN/FrEEa2FuRBtvtcAMiwbQLbFCzlmWhE7swSBvg38ZSFrjhANsEhfNVCtsrtG16fkfrfmBFv4JIog1fEoMKmXg7rhMjpaas8+n52HMFXvjllePRpywK4wB20GOcOuDSdc3i3zs7NFuicGunEpW2S/byrHotSWHZ9VuUwPn3GJ6xorrGyvsRuPS2anhHTSBxYCqYdXg0BIYUn1x5Uhtzd8kIU06gSLsvuhqGCLNucnXAT1Zix7pSlO21be81SX4vwQEth+6Dkm6kja0ArHZL6wglF8Njd1fV9iOwvcS07clwa/2S8suFLwVrQXz16vfAfA2zi4/qeop5Sv9W4DIOZuIMPmbWZCoy7L6Fu4+x4prb8LCQNM5m4CP3HngCW8PpxtBbBJd0dcXVap1HgDTIt/CLH8ms52uX5k3bHuvzryOihSuwmi/cDZAJAmbgclM9klsZr4R/GAoAWhhGxXM2tLuiwZ2nLvCPlXbBazZpdM2aC3VIwnMwJrJFu2u9B6RSsz2ijbygecT98UmiMYK7Mk1y6GkvY+mDQ== ben@lithium diff --git a/Biz/Keys/Deploy.pub b/Biz/Keys/Deploy.pub deleted file mode 100644 index 664a2d9..0000000 --- a/Biz/Keys/Deploy.pub +++ /dev/null @@ -1 +0,0 @@ -ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDlLRbbXgwjF7IqObf4dZE/jj0HoT6xJR6bP/6ZrJz7NPCPIgY3GacOtBfkJp6KK0zKQdFmxNpcfb3zgpe/Ru7pkmSfI9IoWAU3aLPWK2G3tbLPmktGmF9C53OhyXgFtBGr2Q/+wSRKAfN/FrEEa2FuRBtvtcAMiwbQLbFCzlmWhE7swSBvg38ZSFrjhANsEhfNVCtsrtG16fkfrfmBFv4JIog1fEoMKmXg7rhMjpaas8+n52HMFXvjllePRpywK4wB20GOcOuDSdc3i3zs7NFuicGunEpW2S/byrHotSWHZ9VuUwPn3GJ6xorrGyvsRuPS2anhHTSBxYCqYdXg0BIYUn1x5Uhtzd8kIU06gSLsvuhqGCLNucnXAT1Zix7pSlO21be81SX4vwQEth+6Dkm6kja0ArHZL6wglF8Njd1fV9iOwvcS07clwa/2S8suFLwVrQXz16vfAfA2zi4/qeop5Sv9W4DIOZuIMPmbWZCoy7L6Fu4+x4prb8LCQNM5m4CP3HngCW8PpxtBbBJd0dcXVap1HgDTIt/CLH8ms52uX5k3bHuvzryOihSuwmi/cDZAJAmbgclM9klsZr4R/GAoAWhhGxXM2tLuiwZ2nLvCPlXbBazZpdM2aC3VIwnMwJrJFu2u9B6RSsz2ijbygecT98UmiMYK7Mk1y6GkvY+mDQ== ben@lithium diff --git a/Biz/Keys/Nick.key b/Biz/Keys/Nick.key new file mode 100644 index 0000000..4dc08fb --- /dev/null +++ b/Biz/Keys/Nick.key @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDfSOxXJTQADjROqbaiJtjbJaHTsBtuWNvQpDvXLigl9R27VqIn7dYk2STuWglwFyrvYfU1UmjgJcJ6J2KbXGTH5mhaC04MJ4aqmOR3Ynnq7nDzmtEtn1I+K7LmpFXsFXgOTzIlzggIWflGd1pPBwgWqMoPDcSqNQFPI/+rk1JOxk3e2Mq60VTp9WM9hs0AJQEyZ+wwZ0vyrj588kQb6jQUZ7qx1UZoDzPc57zREEZbQeU1Gd9FK2bCHlKOBHYlqIftSRBGGCpuo7zobhajR0xHO9RnF0NmeLbW85XhDus8vVgBg/BTDPxHEzm5jKiCkc+i3ia0Ff9mp2zgtSdXCp5jbVZ3AYfYLi1zbPWmaSdWqFx2ntOLwWR3/RHjw6+b4KmUQ4xtQHyXOijTBCH29i7VCo7l8WL+I2mSGJ7/Wtw7NFtMpVVs8/0iKt2t12FIefzvbZoWU7vbmuO7+gQI5l+F+JE6DLWOl04vT/V98WxiHA5rbCjTT/bubs4gTeCR9qNehaoM+apitpUP8HXygnxD7EJeK6JNkdub9TY663IkiKlpnWgeoDTNSP7JF/jkU0Nt8yoR2pTyxQqMFYa37/3WKjmSHk1TgxLEmlwHQFtIkTPn8PL+VLa4ACYuWUjxS4aMRpxo9eJUHdy0Y04yKxXN8BLw7FAhytm2pTXtT4zqaQ== nicksima@gmail.com diff --git a/Biz/Keys/Nick.pub b/Biz/Keys/Nick.pub deleted file mode 100644 index 4dc08fb..0000000 --- a/Biz/Keys/Nick.pub +++ /dev/null @@ -1 +0,0 @@ -ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDfSOxXJTQADjROqbaiJtjbJaHTsBtuWNvQpDvXLigl9R27VqIn7dYk2STuWglwFyrvYfU1UmjgJcJ6J2KbXGTH5mhaC04MJ4aqmOR3Ynnq7nDzmtEtn1I+K7LmpFXsFXgOTzIlzggIWflGd1pPBwgWqMoPDcSqNQFPI/+rk1JOxk3e2Mq60VTp9WM9hs0AJQEyZ+wwZ0vyrj588kQb6jQUZ7qx1UZoDzPc57zREEZbQeU1Gd9FK2bCHlKOBHYlqIftSRBGGCpuo7zobhajR0xHO9RnF0NmeLbW85XhDus8vVgBg/BTDPxHEzm5jKiCkc+i3ia0Ff9mp2zgtSdXCp5jbVZ3AYfYLi1zbPWmaSdWqFx2ntOLwWR3/RHjw6+b4KmUQ4xtQHyXOijTBCH29i7VCo7l8WL+I2mSGJ7/Wtw7NFtMpVVs8/0iKt2t12FIefzvbZoWU7vbmuO7+gQI5l+F+JE6DLWOl04vT/V98WxiHA5rbCjTT/bubs4gTeCR9qNehaoM+apitpUP8HXygnxD7EJeK6JNkdub9TY663IkiKlpnWgeoDTNSP7JF/jkU0Nt8yoR2pTyxQqMFYa37/3WKjmSHk1TgxLEmlwHQFtIkTPn8PL+VLa4ACYuWUjxS4aMRpxo9eJUHdy0Y04yKxXN8BLw7FAhytm2pTXtT4zqaQ== nicksima@gmail.com 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 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" ]; }; }; diff --git a/Control/Concurrent/Sema.hs b/Control/Concurrent/Sema.hs index c105cf8..202aa65 100644 --- a/Control/Concurrent/Sema.hs +++ b/Control/Concurrent/Sema.hs @@ -1,8 +1,11 @@ +-- : dep SafeSemaphore module Control.Concurrent.Sema ( mapPool, ) where +import Alpha +import Control.Concurrent.Async (mapConcurrently) import qualified Control.Concurrent.MSem as Sem -- | Simaphore-based throttled 'mapConcurrently'. diff --git a/System/Random/Shuffle.hs b/System/Random/Shuffle.hs index d26361f..435f083 100644 --- a/System/Random/Shuffle.hs +++ b/System/Random/Shuffle.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -funbox-strict-fields #-} -- | @@ -24,6 +26,7 @@ module System.Random.Shuffle ) where +import Alpha import Control.Monad ( liftM2, ) @@ -70,7 +73,7 @@ shuffle elements = shuffleTree (buildTree elements) shuffleTree (Leaf e) [] = [e] shuffleTree tree (r : rs) = let (b, rest) = extractTree r tree in b : shuffleTree rest rs - shuffleTree _ _ = error "[shuffle] called with lists of different lengths" + shuffleTree _ _ = panic "[shuffle] called with lists of different lengths" -- Extracts the n-th element from the tree and returns -- that element, paired with a tree with the element -- deleted. @@ -86,7 +89,7 @@ shuffle elements = shuffleTree (buildTree elements) let (e, l') = extractTree n l in (e, Node (c - 1) l' r) | otherwise = let (e, r') = extractTree (n - cl) r in (e, Node (c - 1) l r') - extractTree _ _ = error "[extractTree] impossible" + extractTree _ _ = panic "[extractTree] impossible" -- | Given a sequence (e1,...en) to shuffle, its length, and a random -- generator, compute the corresponding permutation of the input -- cgit v1.2.3