summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Auth.hs6
-rw-r--r--Biz/Bild.hs44
-rw-r--r--Biz/Bild.nix34
-rw-r--r--Biz/Bild/Builder.nix2
-rw-r--r--Biz/Bild/Constants.nix2
-rw-r--r--Biz/Bild/Deps.hs14
-rw-r--r--Biz/Bild/Deps/Haskell.nix3
-rw-r--r--Biz/Bild/Deps/exllama.nix3
-rw-r--r--Biz/Bild/Haskell.nix40
-rw-r--r--Biz/Bild/Meta.hs2
-rw-r--r--Biz/Bild/Nixpkgs.nix25
-rw-r--r--Biz/Bild/Python.nix8
-rw-r--r--Biz/Bild/Sources.json24
-rw-r--r--Biz/Dev/Beryllium/Configuration.nix5
-rw-r--r--Biz/Dev/Lithium/Configuration.nix9
-rw-r--r--Biz/Dragons.hs81
-rw-r--r--Biz/Lint.hs3
-rw-r--r--Biz/Log.hs6
-rw-r--r--Biz/Look.hs12
-rw-r--r--Biz/Namespace.hs42
-rw-r--r--Biz/Que/Host.hs22
-rw-r--r--Biz/Test.hs2
22 files changed, 185 insertions, 204 deletions
diff --git a/Biz/Auth.hs b/Biz/Auth.hs
index 9eb81a8..73022d7 100644
--- a/Biz/Auth.hs
+++ b/Biz/Auth.hs
@@ -134,8 +134,8 @@ githubOauth (GitHub OAuthArgs {..}) code =
<| "client_id"
=: clientId
<> "client_secret"
- =: clientSecret
+ =: clientSecret
<> "code"
- =: code
+ =: code
<> "state"
- =: clientState
+ =: clientState
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 1ca0a2c..bae0328 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -198,7 +198,8 @@ test_bildExamples =
move :: Cli.Arguments -> IO ()
move args =
IO.hSetBuffering stdout IO.NoBuffering
- >> Env.getEnv "CODEROOT" +> \root ->
+ >> Env.getEnv "CODEROOT"
+ +> \root ->
Cli.getAllArgs args (Cli.argument "target")
|> filterM Dir.doesFileExist
+> filterM (\x -> isGitIgnored x /> don't)
@@ -344,7 +345,7 @@ data Compiler
| Sbcl
deriving (Eq, Show, Generic)
-compilerExe :: IsString a => Compiler -> a
+compilerExe :: (IsString a) => Compiler -> a
compilerExe = \case
Copy -> "cp"
CPython -> "python"
@@ -534,7 +535,7 @@ analyze hmap ns = case Map.lookup ns hmap of
withFile abspath ReadMode <| \h ->
IO.hSetEncoding h IO.utf8_bom
>> Text.IO.hGetContents h
- /> Text.lines
+ /> Text.lines
case ext of
-- basically we don't support building these
Namespace.Css -> pure Nothing
@@ -724,10 +725,10 @@ analyze hmap ns = case Map.lookup ns hmap of
"guile -C \""
<> root
</> intdir
- <> "\" -e main "
- <> "-s "
- <> Namespace.toPath namespace
- <> " \"$@\""
+ <> "\" -e main "
+ <> "-s "
+ <> Namespace.toPath namespace
+ <> " \"$@\""
]
|> joinWith "\n"
|> Text.pack
@@ -950,7 +951,7 @@ data Proc = Proc
}
-- | Convert minutes to milliseconds.
-toMillis :: Num a => a -> a
+toMillis :: (Num a) => a -> a
toMillis mins = mins * 60_000_000
-- | Run a subprocess, streaming output if --loud is set.
@@ -959,23 +960,24 @@ run Proc {..} = do
IO.hSetBuffering stdout IO.NoBuffering
loud ?| Log.info ["proc", unwords <| map str <| cmd : args]
Conduit.proc cmd args
- |> (\proc -> proc {Process.create_group = True})
+ |> (\proc_ -> proc_ {Process.create_group = True})
|> Conduit.streamingProcess
+> \(Conduit.UseProvidedHandle, stdout_, stderr_, hdl) ->
- (,,) </ Async.Concurrently (Conduit.waitForStreamingProcess hdl)
+ (,,)
+ </ Async.Concurrently (Conduit.waitForStreamingProcess hdl)
<*> Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_))
<*> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_))
- |> Async.runConcurrently
- +> \case
- (Exit.ExitFailure n, output, outerr) ->
- Conduit.closeStreamingProcessHandle hdl
- >> putStr outerr
- >> onFailure
- >> pure (Exit.ExitFailure n, output)
- (Exit.ExitSuccess, output, _) ->
- Conduit.closeStreamingProcessHandle hdl
- >> onSuccess
- >> pure (Exit.ExitSuccess, output)
+ |> Async.runConcurrently
+ +> \case
+ (Exit.ExitFailure n, output, outerr) ->
+ Conduit.closeStreamingProcessHandle hdl
+ >> putStr outerr
+ >> onFailure
+ >> pure (Exit.ExitFailure n, output)
+ (Exit.ExitSuccess, output, _) ->
+ Conduit.closeStreamingProcessHandle hdl
+ >> onSuccess
+ >> pure (Exit.ExitSuccess, output)
-- | Helper for running a standard bild subprocess.
proc ::
diff --git a/Biz/Bild.nix b/Biz/Bild.nix
index c92f749..c6e2f27 100644
--- a/Biz/Bild.nix
+++ b/Biz/Bild.nix
@@ -5,15 +5,12 @@ let
# expose some attrs from stable, keep this minimal and simple
stable = {
- inherit (nixpkgs.nixos-23_05)
- sources lib makeWrapper ccacheStdenv haskellPackages haskell
- lispPackages_new python3 nixos mkShell dockerTools;
- stdenv = nixpkgs.nixos-23_05.ccacheStdenv;
+ inherit (nixpkgs.nixos-23_11)
+ sources lib makeWrapper ccacheStdenv haskell lispPackages_new python3
+ nixos mkShell dockerTools pkgs;
+ stdenv = nixpkgs.nixos-23_11.ccacheStdenv;
};
- # for exposing packages as bild.pkgs
- stable-pkgs = nixpkgs.nixos-23_05.pkgs;
-
# this is the main library definitions, recursive references can be made with
# `self.thing`, like in Python objects
self = {
@@ -25,9 +22,12 @@ let
haskell = rec {
inherit (constants) ghcCompiler;
+ ghcVersion = ghcPackageSetFull.version;
+
# all available packages
deps = import ./Bild/Deps/Haskell.nix;
- packages = self.lib.attrsets.getAttrs self.deps stable.haskellPackages;
+ packages = self.lib.attrsets.getAttrs self.haskell.deps
+ stable.haskell.packages."${constants.ghcCompiler}";
# make a ghc with dependencies
ghcWith = stable.haskell.packages.${ghcCompiler}.ghcWithHoogle;
@@ -72,14 +72,15 @@ let
# c packages are just stable, filtered to just the list of deps i want
c.packages =
- self.lib.attrsets.getAttrs (import ./Bild/Deps/C.nix) stable-pkgs;
+ self.lib.attrsets.getAttrs (import ./Bild/Deps/C.nix) stable.pkgs;
# exposed packages for inclusion in builds
- pkgs = with stable-pkgs; {
+ pkgs = with stable.pkgs; {
inherit bat bc cmark ctags deadnix fd figlet fzf git git-branchless
gitlint guile hlint indent jq lolcat mypy nixfmt ormolu pkg-config
- ripgrep rustc shellcheck tree wemux;
+ ripgrep rustc tree wemux;
ruff = nixpkgs.nixos-unstable-small.ruff;
+ shellcheck = nixpkgs.nixos-unstable-small.shellcheck;
};
# a standard nix build for bild, for bootstrapping. this should be the only
@@ -101,11 +102,12 @@ let
(p: with p; [ asdf alexandria ])) # just enough to build Example.lisp
];
strictDeps = true;
+ ghcVersion = self.haskell.ghcVersion;
buildPhase = ''
- mkdir -p $out/bin $out/lib/ghc-${self.haskell.ghcPackageSetFull.version}
+ mkdir -p $out/bin $out/lib/ghc-$ghcVersion
cp -r \
- ${self.haskell.ghcPackageSetFull}/lib/ghc-${self.haskell.ghcPackageSetFull.version}/package.conf.d \
- $out/lib/ghc-${self.haskell.ghcPackageSetFull.version}
+ ${self.haskell.ghcPackageSetFull}/lib/ghc-$ghcVersion/package.conf.d \
+ $out/lib/ghc-$ghcVersion
ghc \
-threaded \
-Werror \
@@ -123,7 +125,7 @@ let
]
} \
--set GHC_PACKAGE_PATH \
- $out/lib/ghc-${self.haskell.ghcPackageSetFull.version}/package.conf.d
+ $out/lib/ghc-$ghcVersion/package.conf.d
'';
};
@@ -184,7 +186,7 @@ let
wemux
];
shellHook = ''
- export GHC_PACKAGE_PATH=${self.bild}/lib/ghc-${self.haskell.ghcPackageSetFull.version}/package.conf.d
+ export GHC_PACKAGE_PATH=${self.bild}/lib/ghc-${self.haskell.ghcVersion}/package.conf.d
'';
};
diff --git a/Biz/Bild/Builder.nix b/Biz/Bild/Builder.nix
index 1a2460a..cf4d1e0 100644
--- a/Biz/Bild/Builder.nix
+++ b/Biz/Bild/Builder.nix
@@ -109,7 +109,7 @@ let
inherit name src CODEROOT;
propagatedBuildInputs = langdeps_ ++ sysdeps_;
buildInputs = sysdeps_;
- nativeCheckInputs = lib.attrsets.attrVals [ "mypy" "ruff" ] pkgs;
+ nativeCheckInputs = [ pkgs.ruff python.packages.mypy ];
checkPhase = ''
check() {
$@ || { echo "fail: $name: $3"; exit 1; }
diff --git a/Biz/Bild/Constants.nix b/Biz/Bild/Constants.nix
index 35fd880..20c992e 100644
--- a/Biz/Bild/Constants.nix
+++ b/Biz/Bild/Constants.nix
@@ -1 +1 @@
-{ ghcCompiler = "ghc924"; }
+{ ghcCompiler = "ghc948"; }
diff --git a/Biz/Bild/Deps.hs b/Biz/Bild/Deps.hs
index 08e3ee6..0b57a4f 100644
--- a/Biz/Bild/Deps.hs
+++ b/Biz/Bild/Deps.hs
@@ -50,7 +50,7 @@ getFindSourcesJson = do
root <- li <| getEnv "CODEROOT"
pure <| AtPath <| root </> "Biz/Bild/Sources.json"
-li :: MonadIO io => IO a -> io a
+li :: (MonadIO io) => IO a -> io a
li = liftIO
main :: IO ()
@@ -391,7 +391,7 @@ cmdShow = \case
sources <- unSources </ li (getSources fsj)
forWithKeyM_ sources <| showPackage
-showPackage :: MonadIO io => PackageName -> PackageSpec -> io ()
+showPackage :: (MonadIO io) => PackageName -> PackageSpec -> io ()
showPackage (PackageName pname) (PackageSpec spec) = do
tsay <| tbold pname
forM_ (KM.toList spec) <| \(attrName, attrValValue) -> do
@@ -684,8 +684,8 @@ abortUpdateFailed errs =
abort
<| T.unlines
<| ["One or more packages failed to update:"]
- <> map
- ( \(PackageName pname, e) ->
- pname <> ": " <> tshow e
- )
- errs
+ <> map
+ ( \(PackageName pname, e) ->
+ pname <> ": " <> tshow e
+ )
+ errs
diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix
index f34bfab..8115688 100644
--- a/Biz/Bild/Deps/Haskell.nix
+++ b/Biz/Bild/Deps/Haskell.nix
@@ -23,7 +23,6 @@
"fast-logger"
"filepath"
"github"
- "hashids"
"haskeline"
"hostname"
"http-types"
@@ -31,7 +30,6 @@
"katip"
"lucid"
"monad-logger"
- "monad-metrics"
"mtl"
"neat-interpolation"
"network-uri"
@@ -53,7 +51,6 @@
"servant-server"
"split"
"stm"
- "stripe-haskell"
"tasty"
"tasty-hunit"
"tasty-quickcheck"
diff --git a/Biz/Bild/Deps/exllama.nix b/Biz/Bild/Deps/exllama.nix
index 51a05e9..434e9a9 100644
--- a/Biz/Bild/Deps/exllama.nix
+++ b/Biz/Bild/Deps/exllama.nix
@@ -1,7 +1,7 @@
{ lib, sources, buildPythonPackage, pythonOlder
, torch # tested on 2.0.1 and 2.1.0 (nightly) with cu118
, safetensors, sentencepiece, ninja, cudaPackages, addOpenGLRunpath, which
-, gcc11 # cuda 11.7 requires g++ <12
+, libGL, gcc11 # cuda 11.7 requires g++ <12
}:
buildPythonPackage rec {
@@ -23,6 +23,7 @@ buildPythonPackage rec {
nativeBuildInputs = [
gcc11
which
+ libGL
addOpenGLRunpath
cudaPackages.cuda_nvcc
cudaPackages.cuda_cudart
diff --git a/Biz/Bild/Haskell.nix b/Biz/Bild/Haskell.nix
index 2c0529a..c744848 100644
--- a/Biz/Bild/Haskell.nix
+++ b/Biz/Bild/Haskell.nix
@@ -1,11 +1,10 @@
_self: super:
let
- ghcCompiler = "ghc924";
+ inherit (import ./Constants.nix) ghcCompiler;
+
buildCabal = sel: name: sel.callCabal2nix name super.sources.${name} { };
- buildCabalSubdir = sel:
- { name, src ? super.sources.${name}, subdir ? name }:
- sel.callCabal2nix name (src + "/${subdir}") { };
+
in rec {
haskell = super.haskell // {
@@ -15,30 +14,23 @@ in rec {
overrides = with super.pkgs.haskell.lib;
sel: sup:
super.overridePinnedDeps (buildCabal sel) // {
- acid-state =
- dontCheck sup.acid-state; # mac: "too many open files"
+ ap-normalize = dontCheck sup.ap-normalize;
clay = doJailbreak sup.clay;
- envy = doJailbreak sup.envy;
- fast-tags =
- sup.fast-tags.overrideAttrs (old: old // { patches = [ ]; });
- generic-data = dontCheck
- sup.generic-data; # https://github.com/Lysxia/generic-data/issues/56
- readable =
- doJailbreak sup.readable; # why is this even being built?
- servant-auth = doJailbreak (buildCabalSubdir sel {
- name = "servant-auth";
- subdir = "servant-auth/servant-auth";
- });
- servant-server = doJailbreak sup.servant-server;
- stripe-core = doJailbreak sup.stripe-core;
- stripe-haskell = dontCheck sup.stripe-haskell;
- stripe-http-client =
- doJailbreak (dontCheck sup.stripe-http-client);
- temporary = dontCheck sup.temporary;
- wai-middleware-metrics = dontCheck sup.wai-middleware-metrics;
+ cmark = doJailbreak sup.cmark;
+ docopt = buildCabal sel "docopt";
+ linear-generics = doJailbreak sup.linear-generics;
+ req = doJailbreak sup.req;
+ servant-auth = doJailbreak sup.servant-auth;
+ servant-auth-server = dontCheck sup.servant-auth-server;
+ shellcheck = doJailbreak sup.shellcheck;
+ string-qq = doJailbreak sup.string-qq;
+ syb-with-class = doJailbreak sup.syb-with-class;
+ th-abstraction = doJailbreak sup.th-abstraction;
};
});
};
};
+ ormolu = super.haskellPackages.ormolu;
+
}
diff --git a/Biz/Bild/Meta.hs b/Biz/Bild/Meta.hs
index ad5fdd6..0025d94 100644
--- a/Biz/Bild/Meta.hs
+++ b/Biz/Bild/Meta.hs
@@ -47,7 +47,7 @@ data Parsed = Parsed
prun :: Set Run
}
-detect :: Ord a => Regex.RE Char a -> [Text] -> Set a
+detect :: (Ord a) => Regex.RE Char a -> [Text] -> Set a
detect m cl =
cl
/> Text.unpack
diff --git a/Biz/Bild/Nixpkgs.nix b/Biz/Bild/Nixpkgs.nix
index 3de56c4..8bc9cad 100644
--- a/Biz/Bild/Nixpkgs.nix
+++ b/Biz/Bild/Nixpkgs.nix
@@ -11,41 +11,34 @@ let
system = __currentSystem;
+ # override pinned deps with our sources, this must come before other
+ # package overlays, because of the 'null' from 'overrideSource'
+ depsOverlay = _: pkgs: pkgs.overridePinnedDeps pkgs.overrideSource;
+
in {
- nixos-23_05 = import sources.nixos-23_05 {
+ nixos-23_11 = import sources.nixos-23_11 {
inherit system config;
overlays = [
(_: _: { inherit sources; })
(import ./CcacheWrapper.nix)
(import ./Functions.nix)
-
- # override pinned deps with our sources, this must come before other
- # package overlays, because of the 'null' from 'overrideSource'
- (_: pkgs: pkgs.overridePinnedDeps pkgs.overrideSource)
-
+ depsOverlay
(import ./Deps.nix)
(import ./Python.nix)
(import ./Haskell.nix)
];
};
- nixos-23_11 = import sources.nixos-23_11 {
- inherit system config;
- overlays = [
- (_: _: { inherit sources; })
- (import ./CcacheWrapper.nix)
- (import ./Functions.nix)
- (import ./Deps.nix)
- ];
- };
-
nixos-unstable-small = import sources.nixos-unstable-small {
inherit system config;
overlays = [
(_: _: { inherit sources; })
(import ./CcacheWrapper.nix)
(import ./Functions.nix)
+ depsOverlay
(import ./Deps.nix)
+ (import ./Python.nix)
+ (import ./Haskell.nix)
];
};
diff --git a/Biz/Bild/Python.nix b/Biz/Bild/Python.nix
index 51f35f1..5569352 100644
--- a/Biz/Bild/Python.nix
+++ b/Biz/Bild/Python.nix
@@ -4,12 +4,8 @@ _self: super: {
with pysuper.pkgs.python3Packages;
let dontCheck = p: p.overridePythonAttrs (_: { doCheck = false; });
in {
- exllama = callPackage ./Deps/exllama.nix {
- cudaPackages = super.pkgs.cudaPackages_11_7;
- };
- exllamav2 = callPackage ./Deps/exllamav2.nix {
- cudaPackages = super.pkgs.cudaPackages_11_7;
- };
+ exllama = callPackage ./Deps/exllama.nix { };
+ exllamav2 = callPackage ./Deps/exllamav2.nix { };
interegular = callPackage ./Deps/interegular.nix { };
mypy = dontCheck pysuper.mypy;
outlines = callPackage ./Deps/outlines.nix { };
diff --git a/Biz/Bild/Sources.json b/Biz/Bild/Sources.json
index ed6b096..40bcdfb 100644
--- a/Biz/Bild/Sources.json
+++ b/Biz/Bild/Sources.json
@@ -13,16 +13,17 @@
"version": "cc7729b1b42a79e261091ff7835f7fc2a7ae3cee"
},
"docopt": {
- "branch": "master",
+ "branch": "main",
"description": "A command-line interface description language and parser that will make you smile",
"homepage": "http://docopt.org/",
"owner": "docopt",
"repo": "docopt.hs",
- "rev": "cdd32227eaff46fb57330ced96d5c290cbd9e035",
- "sha256": "1nfbm7fpmk522n58d52m44y86a7z4nm6gc3m3gc1hb3wac6vmffc",
+ "rev": "47516acafeae3e1fdc447716e6ea05c2b918ff3a",
+ "sha256": "07skrfhzx51yn4qvig3ps34qra9s5g6m4k2z42h9ys0ypyk2wf8w",
"type": "tarball",
- "url": "https://github.com/docopt/docopt.hs/archive/cdd32227eaff46fb57330ced96d5c290cbd9e035.tar.gz",
- "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
+ "url": "https://github.com/docopt/docopt.hs/archive/47516acafeae3e1fdc447716e6ea05c2b918ff3a.tar.gz",
+ "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
+ "version": "0.7.0.8"
},
"exllama": {
"branch": "master",
@@ -194,18 +195,5 @@
"url": "https://github.com/feuerbach/regex-applicative/archive/449519c38e65753345e9a008362c011cb7a0a4d9.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
"version": "0.3.4"
- },
- "servant-auth": {
- "branch": "master",
- "description": null,
- "homepage": null,
- "owner": "haskell-servant",
- "repo": "servant",
- "rev": "f0e2316895ee5fda52ba9d5b2b7e10f8a80a9019",
- "sha256": "0ndan9zxvg5zvrl42zvppc9vhbn5skgsyqyxp2v685h82lfz74ps",
- "type": "tarball",
- "url": "https://github.com/haskell-servant/servant/archive/f0e2316895ee5fda52ba9d5b2b7e10f8a80a9019.tar.gz",
- "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
- "version": "0.4.0.0"
}
}
diff --git a/Biz/Dev/Beryllium/Configuration.nix b/Biz/Dev/Beryllium/Configuration.nix
index 7699305..e3e4232 100644
--- a/Biz/Dev/Beryllium/Configuration.nix
+++ b/Biz/Dev/Beryllium/Configuration.nix
@@ -2,7 +2,7 @@
# your system. Help is available in the configuration.nix(5) man page
# and in the NixOS manual (accessible by running ‘nixos-help’).
-{ config, pkgs, ... }:
+{ pkgs, ... }:
{
imports = [ # Include the results of the hardware scan.
@@ -109,9 +109,6 @@
services.eternal-terminal.enable = true;
- # Allow unfree packages
- nixpkgs.config.allowUnfree = true;
-
# List packages installed in system profile. To search, run:
# $ nix search wget
environment.systemPackages = with pkgs; [
diff --git a/Biz/Dev/Lithium/Configuration.nix b/Biz/Dev/Lithium/Configuration.nix
index e6cbdfe..b4e0660 100644
--- a/Biz/Dev/Lithium/Configuration.nix
+++ b/Biz/Dev/Lithium/Configuration.nix
@@ -1,4 +1,4 @@
-{ config, lib, pkgs, ... }:
+{ lib, pkgs, ... }:
let
ghcCompiler = (import ../../Bild/Constants.nix).ghcCompiler;
@@ -27,13 +27,6 @@ in {
environment.systemPackages =
[ pkgs.nvtop pkgs.k3s pkgs.wemux pkgs.tmux pkgs.wireguard-tools ];
- nixpkgs = {
- config = {
- allowUnfree = true;
- allowBroken = true;
- };
- };
-
hardware = {
opengl.enable = true;
pulseaudio = {
diff --git a/Biz/Dragons.hs b/Biz/Dragons.hs
index 22596de..7e626da 100644
--- a/Biz/Dragons.hs
+++ b/Biz/Dragons.hs
@@ -477,7 +477,10 @@ instance Lucid.ToHtml AnalysisAction where
Lucid.td_ [Lucid.style_ <| size n totalCommits] <| do
Lucid.span_ [Lucid.class_ "tooltip"]
<| Lucid.toHtml
- <| path <> ": " <> show n <> " commits"
+ <| path
+ <> ": "
+ <> show n
+ <> " commits"
where
simpleBar :: (Show i, Monad m, Num i) => i -> Integer -> Lucid.HtmlT m ()
simpleBar n total = do
@@ -485,7 +488,7 @@ instance Lucid.ToHtml AnalysisAction where
Lucid.tr_
<| do
Lucid.td_ [Lucid.style_ <| size n total] ""
- <> Lucid.td_ [Lucid.style_ <| size total total] ""
+ <> Lucid.td_ [Lucid.style_ <| size total total] ""
len = toInteger <. length
slen = tshow <. length
@@ -497,7 +500,7 @@ instance Lucid.ToHtml AnalysisAction where
percentage_ = div_ "percentage"
size n total = "--size: calc(" <> show n <> "/" <> show total <> ")"
previewChart = div_ "preview-chart"
- desc :: Monad m => Text -> Lucid.HtmlT m ()
+ desc :: (Monad m) => Text -> Lucid.HtmlT m ()
desc = Lucid.p_ <. Cmark.renderNode [] <. Cmark.commonmarkToNode []
-- | Captures an 'Analysis' with metadata used in the webapp to track who asked
@@ -861,64 +864,64 @@ data Paths path = Paths
login ::
path
:- "login"
- :> Verb 'GET 301 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent),
+ :> Verb 'GET 301 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent),
githubAuth ::
path
:- "auth"
- :> "github"
- :> "callback"
- :> QueryParam "code" Text
- :> Get '[Lucid.HTML] (Auth.SetCookies (App.Html UserAccount)),
+ :> "github"
+ :> "callback"
+ :> QueryParam "code" Text
+ :> Get '[Lucid.HTML] (Auth.SetCookies (App.Html UserAccount)),
getAccount ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "account"
- :> Get '[Lucid.HTML] (App.Html UserAccount),
+ :> "account"
+ :> Get '[Lucid.HTML] (App.Html UserAccount),
postAccount ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "account"
- :> ReqBody '[FormUrlEncoded] Subscription
- :> Post '[Lucid.HTML] (App.Html UserAccount),
+ :> "account"
+ :> ReqBody '[FormUrlEncoded] Subscription
+ :> Post '[Lucid.HTML] (App.Html UserAccount),
postAPIKey ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "account"
- :> "api-key"
- :> Post '[Lucid.HTML] (App.Html UserAccount),
+ :> "account"
+ :> "api-key"
+ :> Post '[Lucid.HTML] (App.Html UserAccount),
selectRepo ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "select-repo"
- :> Get '[Lucid.HTML] (App.Html SelectRepo),
+ :> "select-repo"
+ :> Get '[Lucid.HTML] (App.Html SelectRepo),
getAnalyses ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "analysis"
- :> Get '[Lucid.HTML] (App.Html Analyses),
+ :> "analysis"
+ :> Get '[Lucid.HTML] (App.Html Analyses),
getAnalysis ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "analysis"
- :> Capture "analysisId" (Id.Id AnalysisAction)
- :> Get '[Lucid.HTML] (App.Html AnalysisDisplay),
+ :> "analysis"
+ :> Capture "analysisId" (Id.Id AnalysisAction)
+ :> Get '[Lucid.HTML] (App.Html AnalysisDisplay),
postAnalysis ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "analysis"
- :> ReqBody '[FormUrlEncoded] SubmitAnalysis
- :> Post '[Lucid.HTML] (App.Html AnalysisDisplay),
+ :> "analysis"
+ :> ReqBody '[FormUrlEncoded] SubmitAnalysis
+ :> Post '[Lucid.HTML] (App.Html AnalysisDisplay),
putAnalysis ::
path
:- Auth.Auth '[Auth.JWT] User
- :> "analysis"
- :> ReqBody '[JSON] Analysis
- :> Put '[JSON] NoContent,
+ :> "analysis"
+ :> ReqBody '[JSON] Analysis
+ :> Put '[JSON] NoContent,
admin ::
path
:- Auth.Auth '[Auth.Cookie] User
- :> "admin"
- :> Get '[Lucid.HTML] (App.Html AdminDashboard)
+ :> "admin"
+ :> Get '[Lucid.HTML] (App.Html AdminDashboard)
}
deriving (Generic)
@@ -928,7 +931,7 @@ paths = genericApi (Proxy :: Proxy Paths)
-- | Ensures a user is authenticated, then returns the logged-in user for
-- authorization.
guardAuth ::
- MonadError ServerError m =>
+ (MonadError ServerError m) =>
Auth.AuthResult a ->
m a
guardAuth = \case
@@ -938,7 +941,7 @@ guardAuth = \case
Auth.Authenticated user -> pure user
guardAdmin ::
- MonadError ServerError m =>
+ (MonadError ServerError m) =>
Auth.AuthResult User ->
m User
guardAdmin = \case
@@ -990,7 +993,7 @@ htmlApp jwtCfg cooks kp cfg oAuthArgs =
warn msg =
Log.warn [msg]
>> Log.br
- |> liftIO
+ |> liftIO
>> throwError err502 {errBody = str msg}
user <-
GitHub.userInfoCurrentR
@@ -1354,7 +1357,7 @@ instance Lucid.ToHtml Analyses where
[ href analysisId,
css
<| Biz.Look.marginAll (em 1)
- <> Clay.textDecoration Clay.none
+ <> Clay.textDecoration Clay.none
]
<| do
Lucid.div_ <| Lucid.toHtml source
@@ -1379,7 +1382,7 @@ instance Lucid.ToHtml Subscription where
toHtml Free = "Free"
toHtml Invoice = "Invoice me"
-linkAction_ :: ToHttpApiData a => Text -> a -> Lucid.Attribute
+linkAction_ :: (ToHttpApiData a) => Text -> a -> Lucid.Attribute
linkAction_ baseUrl = Lucid.action_ <. (baseUrl <>) <. Servant.toUrlPiece
instance Lucid.ToHtml UserAccount where
@@ -1521,7 +1524,7 @@ tryButton oAuthArgs title subtitle =
Lucid.small_ <| Lucid.toHtml subtitle
-- | Universal header
-header :: Monad m => Maybe User -> Lucid.HtmlT m ()
+header :: (Monad m) => Maybe User -> Lucid.HtmlT m ()
header muser =
Lucid.header_ <| do
Lucid.nav_ <| do
@@ -1540,7 +1543,7 @@ header muser =
li txt href = Lucid.li_ <| a txt href
-- | Universal footer
-footer :: Monad m => Lucid.HtmlT m ()
+footer :: (Monad m) => Lucid.HtmlT m ()
footer =
Lucid.footer_ <| do
Lucid.p_ <| Lucid.i_ "Copyright ©2020-2021 Dragons.dev"
@@ -1640,7 +1643,7 @@ test_spliceCreds =
-- | Clones a repo from GitHub and does the analysis.
analyzeGitHub ::
- GitHub.AuthMethod ghAuth =>
+ (GitHub.AuthMethod ghAuth) =>
Acid.AcidState Keep ->
-- | The User asking for the analysis, we auth as them
User ->
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index af285a7..c971c04 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -293,7 +293,8 @@ runOne mode (ext, ns's) = results +> traverse printResult
lint :: Mode -> Linter -> [Namespace] -> IO Result
lint mode linter@Linter {..} ns's =
Log.info ["lint", exe, (tshow <| length ns's) <> " files"]
- >> Process.readProcessWithExitCode (str exe) args "" /> \case
+ >> Process.readProcessWithExitCode (str exe) args ""
+ /> \case
(Exit.ExitSuccess, _, _) ->
Done linter Good
(Exit.ExitFailure _, msg, _) -> case decoder of
diff --git a/Biz/Log.hs b/Biz/Log.hs
index 8dba657..5c82c28 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -102,7 +102,7 @@ warn = msg Warn
fail = msg Fail
-- | Like 'Debug.trace' but follows the patterns in this module
-mark :: Show a => Text -> a -> a
+mark :: (Show a) => Text -> a -> a
mark label val =
unsafePerformIO <| do
msg Mark [label, tshow val]
@@ -114,11 +114,11 @@ mark label val =
-- @
-- mark label val = val ~& label
-- @
-(~&) :: Show a => a -> Text -> a
+(~&) :: (Show a) => a -> Text -> a
val ~& label = mark label val
-- | Conditional mark.
-(~?) :: Show a => a -> (a -> Bool) -> Text -> a
+(~?) :: (Show a) => a -> (a -> Bool) -> Text -> a
(~?) val test label = if test val then mark label val else val
wai :: Wai.Middleware
diff --git a/Biz/Look.hs b/Biz/Look.hs
index 2e05993..7258375 100644
--- a/Biz/Look.hs
+++ b/Biz/Look.hs
@@ -126,11 +126,13 @@ fuckingStyle = do
]
[sansSerif]
"main" ? Flexbox.flex 1 0 auto
- "main" <> "header" <> "footer" ? do
- maxWidth (px 900)
- width (pct 100)
- margin (em 1) auto 1 auto
- padding (em 0) 0 0 0
+ "main"
+ <> "header"
+ <> "footer" ? do
+ maxWidth (px 900)
+ width (pct 100)
+ margin (em 1) auto 1 auto
+ padding (em 0) 0 0 0
"h1" <> "h2" <> "h3" ? lineHeight (em 1.2)
query Clay.all [prefersDark] <| do
"body" ? do
diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
index 8f5058e..aa69a9c 100644
--- a/Biz/Namespace.hs
+++ b/Biz/Namespace.hs
@@ -130,20 +130,34 @@ rePath = Regex.many (name <* Regex.string "/" <|> name)
reExt :: Regex.RE Char Ext
reExt =
- C <$ Regex.string "c"
- <|> Css <$ Regex.string "css"
- <|> Hs <$ Regex.string "hs"
- <|> Html <$ Regex.string "html"
- <|> Json <$ Regex.string "json"
- <|> Keys <$ Regex.string "pub"
- <|> Lisp <$ Regex.string "lisp"
- <|> Md <$ Regex.string "md"
- <|> Nix <$ Regex.string "nix"
- <|> Py <$ Regex.string "py"
- <|> Rs <$ Regex.string "rs"
- <|> Scm <$ Regex.string "scm"
- <|> Sh <$ Regex.string "sh"
- <|> Toml <$ Regex.string "toml"
+ C
+ <$ Regex.string "c"
+ <|> Css
+ <$ Regex.string "css"
+ <|> Hs
+ <$ Regex.string "hs"
+ <|> Html
+ <$ Regex.string "html"
+ <|> Json
+ <$ Regex.string "json"
+ <|> Keys
+ <$ Regex.string "pub"
+ <|> Lisp
+ <$ Regex.string "lisp"
+ <|> Md
+ <$ Regex.string "md"
+ <|> Nix
+ <$ Regex.string "nix"
+ <|> Py
+ <$ Regex.string "py"
+ <|> Rs
+ <$ Regex.string "rs"
+ <|> Scm
+ <$ Regex.string "scm"
+ <|> Sh
+ <$ Regex.string "sh"
+ <|> Toml
+ <$ Regex.string "toml"
-- | The cab dir is for temporary files and build outputs, not for source
-- inputs.
diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs
index 79254ad..f1b986c 100644
--- a/Biz/Que/Host.hs
+++ b/Biz/Que/Host.hs
@@ -127,25 +127,25 @@ data Paths path = Paths
dash ::
path
:- "_"
- :> "dash"
- :> Get '[JSON] Ques,
+ :> "dash"
+ :> Get '[JSON] Ques,
getQue ::
path
:- Capture "ns" Text
- :> Capture "quename" Text
- :> Get '[PlainText, HTML, OctetStream] Message,
+ :> Capture "quename" Text
+ :> Get '[PlainText, HTML, OctetStream] Message,
getStream ::
path
:- Capture "ns" Text
- :> Capture "quename" Text
- :> "stream"
- :> StreamGet NoFraming OctetStream (SourceIO Message),
+ :> Capture "quename" Text
+ :> "stream"
+ :> StreamGet NoFraming OctetStream (SourceIO Message),
putQue ::
path
:- Capture "ns" Text
- :> Capture "quepath" Text
- :> ReqBody '[PlainText, HTML, OctetStream] Text
- :> Post '[PlainText, HTML, OctetStream] NoContent
+ :> Capture "quepath" Text
+ :> ReqBody '[PlainText, HTML, OctetStream] Text
+ :> Post '[PlainText, HTML, OctetStream] NoContent
}
deriving (Generic)
@@ -183,7 +183,7 @@ paths _ =
|> str
|> Go.write q
>> Go.read q -- flush the que, otherwise msgs never clear
- |> liftIO
+ |> liftIO
-- TODO: detect number of readers, respond with "sent to N readers" or
-- "no readers, msg lost"
>> pure NoContent
diff --git a/Biz/Test.hs b/Biz/Test.hs
index 508703b..c81c5cf 100644
--- a/Biz/Test.hs
+++ b/Biz/Test.hs
@@ -45,7 +45,7 @@ group = Tasty.testGroup
unit :: Description -> Assertion -> Tree
unit = HUnit.testCase
-prop :: QuickCheck.Testable a => Description -> a -> Tree
+prop :: (QuickCheck.Testable a) => Description -> a -> Tree
prop = QuickCheck.testProperty
assertFailure :: String -> Assertion
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 07:18:12 +0000