diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..c9293c0 --- /dev/null +++ b/.envrc @@ -0,0 +1,2 @@ +use nix + diff --git a/README.md b/README.md index 126d2e8..cb988c9 100644 --- a/README.md +++ b/README.md @@ -25,7 +25,7 @@ After starting Grafanix, open `localhost:3000` in your browser. I suggest using VSCode with the following plugins: -- Haskell IDE Engine +- ghcide - HTML CSS Support - Elm Support @@ -52,3 +52,9 @@ cd frontend ./scripts/watch.sh # Rebuild on every change ``` + +### Formatting + +```bash +treefmt +``` \ No newline at end of file diff --git a/backend/app/Main.hs b/backend/app/Main.hs index ae6974d..717a637 100644 --- a/backend/app/Main.hs +++ b/backend/app/Main.hs @@ -1,6 +1,6 @@ module Main where -import Control.Error (Script, runExceptT) +import Control.Error (Script) import System.Environment (getExecutablePath) import System.FilePath ((), takeDirectory) import Protolude hiding (get) diff --git a/backend/grafanix.cabal b/backend/grafanix.cabal index c23c472..856b387 100644 --- a/backend/grafanix.cabal +++ b/backend/grafanix.cabal @@ -22,7 +22,7 @@ library grafanix-internal , containers , errors , hashable - , lrucaching + , lrucache , optparse-applicative , protolude , text diff --git a/backend/src/Config.hs b/backend/src/Config.hs index 7d2c529..1ea0788 100644 --- a/backend/src/Config.hs +++ b/backend/src/Config.hs @@ -1,6 +1,6 @@ module Config (Config(..), StaticAssetLocation(..), devConfig, readConfig) where -import Data.String (IsString, fromString) +import Data.String (fromString) import Options.Applicative import Protolude hiding (option) @@ -13,8 +13,8 @@ instance IsString StaticAssetLocation where data Config = Config { nixpkgsPath :: Text , staticPath :: StaticAssetLocation - , duCacheSize :: Int - , whyCacheSize :: Int + , duCacheSize :: Integer + , whyCacheSize :: Integer , port :: Int } deriving (Show) diff --git a/backend/src/Nix.hs b/backend/src/Nix.hs index a106dc8..99fd831 100644 --- a/backend/src/Nix.hs +++ b/backend/src/Nix.hs @@ -1,96 +1,88 @@ module Nix - ( drvPath - , pkgPath - , depGraph + ( drvPath, + pkgPath, + depGraph, ) where -import Control.Error ( Script - , scriptIO - ) -import Data.Attoparsec.Text ( Parser - , parseOnly - ) -import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy -import qualified Data.ByteString.Lazy.Builder as ByteString.Builder -import Data.Hashable ( Hashable ) -import Data.IORef ( atomicModifyIORef ) -import Data.LruCache ( insert - , lookup - ) -import Data.LruCache.IO ( LruHandle(..) ) -import Data.Map ( Map ) -import qualified Data.Map as Map -import Data.Vector ( Vector ) -import qualified Data.Vector as Vector -import qualified Data.Text as Text -import System.Process.Typed -import Protolude - -import Config +import Config +import Control.Error + ( Script, + scriptIO, + ) +import Data.Attoparsec.Text + ( Parser, + parseOnly, + ) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as C +import Data.Cache.LRU.IO (AtomicLRU, insert, lookup) +import qualified Data.Map as Map +import qualified Data.Text as Text +import Data.Vector (Vector) +import qualified Data.Vector as Vector import qualified Parser -import Types +import Protolude +import System.Process.Typed +import Types -decolor :: ByteString.Lazy.ByteString -> ByteString.Lazy.ByteString -decolor = ByteString.Builder.toLazyByteString . go mempty - where - go - :: ByteString.Builder.Builder - -> ByteString.Lazy.ByteString - -> ByteString.Builder.Builder - go acc "" = acc - go acc string = - let esc = '\x1b' - colorSequenceStart = "\x1b[" - (text, colored) = ByteString.Lazy.span (/= esc) string - -- Attempt to strip a color sequence - rest = case ByteString.Lazy.stripPrefix colorSequenceStart colored of - Just x -> - -- All color sequences look like this: ESC[#(;#)m - ByteString.Lazy.drop 1 . ByteString.Lazy.dropWhile (/= 'm') $ x - Nothing -> - -- Just skip ESC otherwise - ByteString.Lazy.dropWhile (== esc) colored - in go (acc <> ByteString.Builder.lazyByteString text) rest +decolor :: ByteString -> ByteString +decolor = go mempty + where + go acc "" = acc + go acc string = + let esc = '\x1b' + colorSequenceStart = "\x1b[" + (text, colored) = C.span (/= esc) string + -- Attempt to strip a color sequence + rest = case C.stripPrefix colorSequenceStart colored of + Just x -> + -- All color sequences look like this: ESC[#(;#)m + C.drop 1 . C.dropWhile (/= 'm') $ x + Nothing -> + -- Just skip ESC otherwise + C.dropWhile (== esc) colored + in go (acc <> text) rest run :: Text -> [Text] -> Script Text run cmd args = do putText cmdline let procConfig = - setStdin closed $ setStdout byteStringOutput $ setStderr closed $ proc - (toS cmd) - (map toS args) + setStdin closed $ + setStdout byteStringOutput $ + setStderr closed $ + proc + (toS cmd) + (map toS args) (exitCode, out, err) <- readProcess procConfig if exitCode == ExitSuccess - then return . toS $ decolor out + then return . decodeUtf8 . decolor . L.toStrict $ out else - let message = "Command '" <> cmdline <> "' failed with:\n" <> toS err - in throwError message - where cmdline = cmd <> " " <> Text.unwords args + let message = "Command '" <> cmdline <> "' failed with:\n" <> (decodeUtf8 . L.toStrict $ err) + in throwError message + where + cmdline = cmd <> " " <> Text.unwords args -cached - :: (Hashable k, Ord k) => LruHandle k v -> (k -> Script v) -> k -> Script v -cached (LruHandle ref) script k = do - cachedValue <- scriptIO $ atomicModifyIORef ref $ \cache -> - case lookup k cache of - Nothing -> (cache, Nothing) - Just (v, cache') -> (cache', Just v) +cached :: + (Hashable k, Ord k) => AtomicLRU k v -> (k -> Script v) -> k -> Script v +cached cache script k = do + cachedValue <- scriptIO $ lookup k cache case cachedValue of - Just v -> return v + Just v -> return v Nothing -> do v <- script k - scriptIO $ atomicModifyIORef ref $ \cache -> (insert k v cache, ()) + scriptIO $ insert k v cache return v parse :: Parser a -> Text -> Script a parse parser text = case parseOnly parser text of - Right a -> return a - Left err -> throwError . toS $ err + Right a -> return a + Left err -> throwError . toS $ err drvPath :: Text -> App Text drvPath pkgExpr = do nixpkgs <- asks (nixpkgsPath . config) - out <- lift $ run "nix-instantiate" ["--expr", "with import " <> nixpkgs <> " {}; " <> pkgExpr] + out <- lift $ run "nix-instantiate" ["--expr", "with import " <> nixpkgs <> " {}; " <> pkgExpr] lift $ parse Parser.nixPath out pkgPath :: Text -> App Text @@ -111,14 +103,14 @@ whyDepends (src, dest) = do info :: Text -> App Info info path = do - sizeCache <- asks sizeCache + sizeCache <- asks sizeCache (size, closureSize) <- lift $ cached sizeCache sizeAndClosureSize path - (sha , name ) <- lift $ parse Parser.hashAndName path + (sha, name) <- lift $ parse Parser.hashAndName path return Info {..} depGraph :: Text -> App (DepGraph, Map Int Info, Map (Int, Int) (Vector Why)) depGraph path = do - out <- lift $ run "nix-store" ["--query", "--graph", path] + out <- lift $ run "nix-store" ["--query", "--graph", path] graph <- lift $ parse Parser.depGraph out let DepGraph {..} = graph infoVector <- mapM info nodes @@ -128,11 +120,11 @@ depGraph path = do whyVector <- mapM getWhy textEdges let whyMap = vectorToMap $ Vector.zip edges whyVector return (graph, infoMap, whyMap) - where - vectorToMap :: Ord a => Vector (a, b) -> Map a b - vectorToMap = Map.fromList . Vector.toList + where + vectorToMap :: Ord a => Vector (a, b) -> Map a b + vectorToMap = Map.fromList . Vector.toList - getWhy :: (Text, Text) -> App (Vector Why) - getWhy (src, dest) = do - whyCache <- asks whyCache - lift $ cached whyCache whyDepends (src, dest) + getWhy :: (Text, Text) -> App (Vector Why) + getWhy (src, dest) = do + whyCache <- asks whyCache + lift $ cached whyCache whyDepends (src, dest) diff --git a/backend/src/Parser.hs b/backend/src/Parser.hs index b872840..64c2c7c 100644 --- a/backend/src/Parser.hs +++ b/backend/src/Parser.hs @@ -1,24 +1,26 @@ module Parser where -import Control.Monad ( fail ) -import Data.Attoparsec.Text -import Data.Char -import Data.Maybe -import qualified Data.Map.Strict as Map -import Data.Vector (Vector) -import qualified Data.Vector as Vector -import qualified Data.Text as Text -import Protolude hiding ( hash - , takeWhile - , try - ) -import Types - +import Control.Monad (fail) +import Data.Attoparsec.Text +import Data.Char +import qualified Data.Map.Strict as Map +import Data.Maybe +import qualified Data.Text as Text +import Data.Vector (Vector) +import qualified Data.Vector as Vector +import Protolude hiding + ( from, + hash, + takeWhile, + to, + try, + ) +import Types parseEither :: Parser a -> Text -> Either Text a parseEither parser text = case parseOnly parser text of - Right a -> Right a - Left err -> Left $ toS err + Right a -> Right a + Left err -> Left $ toS err restOfLine :: Parser () restOfLine = takeTill isEndOfLine *> endOfLine @@ -31,10 +33,10 @@ legalNixFileNameChar = inClass "a-zA-Z0-9+.?=_-" hashAndName :: Parser (Text, Text) hashAndName = do - _ <- string "/nix/store/" + _ <- "/nix/store/" <|> "" hash <- takeWhile legalNixHashChar when (Text.length hash /= 32) $ fail "failed to parse hash" - _ <- char '-' + _ <- char '-' name <- takeWhile legalNixFileNameChar return (hash, name) @@ -49,22 +51,21 @@ quoted p = char '"' *> p <* char '"' -- Parse the output of `nix-store --query --graph`, depGraph :: Parser DepGraph depGraph = do - _ <- string "digraph G {" *> restOfLine + _ <- string "digraph G {" *> restOfLine edgesOrNodes <- many (dotEdge <|> dotNode) - _ <- string "}" - let - (n, e) = - Vector.partition (isNothing . snd) . Vector.fromList $ edgesOrNodes - nodes = Vector.map fst n + _ <- string "}" + let (n, e) = + Vector.partition (isNothing . snd) . Vector.fromList $ edgesOrNodes + nodes = Vector.map fst n - addOne (numSoFar, acc) name = (numSoFar + 1, Map.insert name numSoFar acc) - (_, index) = Vector.foldl addOne (0, Map.empty) nodes + addOne (numSoFar, acc) name = (numSoFar + 1, Map.insert name numSoFar acc) + (_, index) = Vector.foldl addOne (0, Map.empty) nodes - mkEdge (source, Just target) = - Just (index Map.! source, index Map.! target) - mkEdge _ = Nothing - edges = Vector.map fromJust . Vector.filter isJust . Vector.map mkEdge $ e - return $ DepGraph { .. } + mkEdge (source, Just target) = + Just (index Map.! source, index Map.! target) + mkEdge _ = Nothing + edges = Vector.map fromJust . Vector.filter isJust . Vector.map mkEdge $ e + return $ DepGraph {..} dotNode :: Parser (Text, Maybe Text) dotNode = do @@ -73,10 +74,10 @@ dotNode = do dotEdge :: Parser (Text, Maybe Text) dotEdge = do - to <- quoted nixPath - _ <- string " -> " + to <- quoted nixPath + _ <- string " -> " from <- quoted nixPath - _ <- restOfLine + _ <- restOfLine return (from, Just to) -- Given the output of `nix why-depends --all $from $to`, @@ -87,29 +88,30 @@ dotEdge = do whyDepends :: Parser (Vector Why) whyDepends = do _ <- nixPath *> string "\n" - whys <- choice - [ why `manyTill` arrow - , return [] - ] + whys <- + choice + [ why `manyTill` arrow, + return [] + ] return $ Vector.fromList whys - where - -- `filepath:…reason…` => Why - why :: Parser Why - why = do - skipWhile isIndent - file <- takeTill (== ':') <* takeTill (== '…') <* char '…' - reason <- takeTill (== '…') - restOfLine - return Why { .. } - - isIndent :: Char -> Bool - isIndent c = c == ' ' || c == '║' || c == '╠' || c == '╚' || c == '═' - - arrow :: Parser () - arrow = do - skipWhile isIndent - _ <- string "=> " - restOfLine + where + -- `filepath:…reason…` => Why + why :: Parser Why + why = do + skipWhile isIndent + file <- takeTill (== ':') <* takeTill (== '…') <* char '…' + reason <- takeTill (== '…') + restOfLine + return Why {..} + + isIndent :: Char -> Bool + isIndent c = c == ' ' || c == '║' || c == '╠' || c == '╚' || c == '═' + + arrow :: Parser () + arrow = do + skipWhile isIndent + _ <- string "=> " + restOfLine -- Given the output of `nix path-info --size --closure-size $path`, -- get size and closure size diff --git a/backend/src/Types.hs b/backend/src/Types.hs index d6d34c9..8e1c942 100644 --- a/backend/src/Types.hs +++ b/backend/src/Types.hs @@ -1,34 +1,34 @@ module Types - ( App - , Env(..) - , Info(..) - , Why(..) - , DepGraph(..) - , emptyGraph - , depsToJson - , makeEnv - , runApp + ( App, + Env (..), + Info (..), + Why (..), + DepGraph (..), + emptyGraph, + depsToJson, + makeEnv, + runApp, ) where -import Control.Error ( Script ) -import Data.Aeson ( ToJSON - , Value - , object - , toJSON - ) -import Data.Maybe -import qualified Data.Map as Map -import Data.Map ( Map ) -import Data.LruCache.IO ( LruHandle - , newLruHandle - ) -import Data.Vector ( Vector ) -import qualified Data.Vector as Vector -import GHC.Generics -import Protolude - -import Config +import Config +import Control.Error (Script) +import Data.Aeson + ( ToJSON, + Value, + object, + toJSON, + ) +import Data.Cache.LRU.IO + ( AtomicLRU, + newAtomicLRU, + ) +import qualified Data.Map as Map +import Data.Maybe +import Data.Vector (Vector) +import qualified Data.Vector as Vector +import GHC.Generics +import Protolude type App = ReaderT Env Script @@ -39,64 +39,69 @@ runApp = flip runReaderT -- Since we are only interested in /nix/store and the store is immutable, -- it is safe to cache information about store paths. data Env = Env - { config :: Config + { config :: Config, -- Cache storing sizes and closure sizes. - , sizeCache :: LruHandle Text (Int, Int) + sizeCache :: AtomicLRU Text (Int, Int), -- Cache storing reasons why there is a dependency between two store paths (src, dest). - , whyCache :: LruHandle (Text, Text) (Vector Why) + whyCache :: AtomicLRU (Text, Text) (Vector Why) } makeEnv :: Config -> IO Env makeEnv config = do - sizeCache <- newLruHandle (fromIntegral . duCacheSize $ config) - whyCache <- newLruHandle (fromIntegral . whyCacheSize $ config) - return Env { .. } + sizeCache <- newAtomicLRU (Just . duCacheSize $ config) + whyCache <- newAtomicLRU (Just . whyCacheSize $ config) + return Env {..} -- A node in a dependency tree data Info = Info - { name :: Text - , sha :: Text - , size :: Int - , closureSize :: Int - } deriving (Eq, Show) + { name :: Text, + sha :: Text, + size :: Int, + closureSize :: Int + } + deriving (Eq, Show) -- A reason why a node depends on its parent data Why = Why - { file :: Text - , reason :: Text - } deriving (Eq, Show, Generic) + { file :: Text, + reason :: Text + } + deriving (Eq, Show, Generic) instance ToJSON Why data DepGraph = DepGraph - { nodes :: Vector Text - , edges :: Vector (Int, Int) - } deriving (Show) + { nodes :: Vector Text, + edges :: Vector (Int, Int) + } + deriving (Show) emptyGraph :: DepGraph -emptyGraph = DepGraph { nodes = Vector.empty, edges = Vector.empty } +emptyGraph = DepGraph {nodes = Vector.empty, edges = Vector.empty} depsToJson :: DepGraph -> Map Int Info -> Map (Int, Int) (Vector Why) -> Value depsToJson graph infos whys = object - [ ("nodes", toJSON . Vector.imapMaybe mkNode $ nodes graph) - , ("links", toJSON . Vector.mapMaybe mkLink $ edges graph) + [ ("nodes", toJSON . Vector.imapMaybe mkNode $ nodes graph), + ("links", toJSON . Vector.mapMaybe mkLink $ edges graph) ] - where - mkNode :: Int -> Text -> Maybe Value - mkNode n _ = do - Info {..} <- infos Map.!? n - return $ object - [ ("name" , toJSON name) - , ("size" , toJSON size) - , ("sha" , toJSON sha) - , ("closureSize", toJSON closureSize) - ] - mkLink :: (Int, Int) -> Maybe Value - mkLink (sourceIndex, targetIndex) = do - why <- whys Map.!? (sourceIndex, targetIndex) - return $ object - [ ("source", toJSON sourceIndex) - , ("target", toJSON targetIndex) - , ("why" , toJSON why) - ] + where + mkNode :: Int -> Text -> Maybe Value + mkNode n _ = do + Info {..} <- infos Map.!? n + return $ + object + [ ("name", toJSON name), + ("size", toJSON size), + ("sha", toJSON sha), + ("closureSize", toJSON closureSize) + ] + mkLink :: (Int, Int) -> Maybe Value + mkLink (sourceIndex, targetIndex) = do + why <- whys Map.!? (sourceIndex, targetIndex) + return $ + object + [ ("source", toJSON sourceIndex), + ("target", toJSON targetIndex), + ("why", toJSON why) + ] diff --git a/backend/test/Spec.hs b/backend/test/Spec.hs index 5959beb..120f08a 100644 --- a/backend/test/Spec.hs +++ b/backend/test/Spec.hs @@ -22,6 +22,9 @@ main = do it "works on glibc" $ nixPath `shouldSucceedOn` ("/nix/store/2kcrj1ksd2a14bm5sky182fv2xwfhfap-glibc-2.26-131" :: Text) + it "works without /nix/store" $ + nixPath `shouldSucceedOn` + ("2kcrj1ksd2a14bm5sky182fv2xwfhfap-glibc-2.26-131" :: Text) it "fails on illegal characters" $ nixPath `shouldFailOn` ("/nix/store/2kcrj\"ksd2a14bm5sky182fv2xwfhfap-glibc-2.26-131" :: Text) diff --git a/default.nix b/default.nix index 7a63f32..0273393 100644 --- a/default.nix +++ b/default.nix @@ -1,69 +1,77 @@ {}: let sources = import ./nix/sources.nix; - pkgs = import sources.nixpkgs {}; - static = - import (sources.static-haskell-nix + "/survey") { - integer-simple = true; - }; - haskellCompiler = "ghc864"; + pkgs = import sources.nixpkgs { }; + + haskellCompiler = "ghc927"; + haskellPackages = pkgs.haskell.packages.${haskellCompiler}; + + static = import (sources.static-haskell-nix + "/survey") { + + compiler = haskellCompiler; + integer-simple = false; + }; staticHaskellPackages = static.haskellPackagesWithLibsReadyForStaticLinking; - niv = (import sources.niv { inherit pkgs; }).niv; - hie = (import sources.all-hies {}).versions."${haskellCompiler}"; - websocat = (import sources.unstable {}).websocat; - d3 = sources.d3; + d3 = builtins.fetchurl { + url = "https://d3js.org/d3.v5.min.js"; + sha256 = "0g5529s28dm27sqp5zzff1ipva1fyipdswl51c7h3ps7715r5gjx"; + }; - bootstrap = sources.bootstrap; + bootstrap = builtins.fetchurl { + url = "https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css"; + sha256 = "0dldiln2s3z8iqc5ccjid2i5gh9527naas064bwly8x9lrfrxcb0"; + }; in - rec { - backend = pkgs.haskellPackages.callPackage ./nix/grafanix-backend.nix {}; - backend-static = staticHaskellPackages.callPackage ./nix/grafanix-backend.nix { - static = true; - zlib = static.pkgs.zlib; +rec { + backend = haskellPackages.callPackage ./nix/grafanix-backend.nix { + static = false; + }; + backend-static = staticHaskellPackages.callPackage ./nix/grafanix-backend.nix { + static = true; + ncurses = static.pkgs.ncurses.override { + enableStatic = true; }; + zlib = static.pkgs.zlib; + }; - frontend = pkgs.callPackage ./frontend {}; + frontend = pkgs.callPackage ./frontend/default.nix { }; - grafanix = pkgs.callPackage ./nix/grafanix.nix { - inherit bootstrap d3; - inherit backend frontend; - }; - grafanix-static = pkgs.callPackage ./nix/grafanix.nix { - inherit bootstrap d3; - inherit frontend; - backend = backend-static; - }; + grafanix = pkgs.callPackage ./nix/grafanix.nix { + inherit bootstrap d3; + inherit backend frontend; + }; + grafanix-static = pkgs.callPackage ./nix/grafanix.nix { + inherit bootstrap d3; + inherit frontend; + backend = backend-static; + }; - grafanix-release = pkgs.callPackage ./nix/grafanix-release.nix { - grafanix = grafanix-static; - }; + grafanix-release = pkgs.callPackage ./nix/grafanix-release.nix { + grafanix = grafanix-static; + }; - shell = ( - pkgs.haskell.lib.addBuildTools - backend - ( - [ - hie - pkgs.haskellPackages.cabal2nix - pkgs.haskellPackages.cabal-install - pkgs.haskellPackages.hoogle - pkgs.haskellPackages.ghcid - pkgs.haskellPackages.stack - niv - websocat - ] ++ - frontend.buildInputs - ) - ).env.overrideAttrs ( - old: { - shellHook = '' - ( - cd ${builtins.toString ./static} - ln -snf ${bootstrap} bootstrap.css - ln -snf ${d3} d3.js - ) - ''; - } - ); - } + shell = ( + pkgs.haskell.lib.addBuildTools + backend + ( + [ + haskellPackages.cabal2nix + haskellPackages.cabal-install + haskellPackages.ghcide + haskellPackages.ormolu + pkgs.elm2nix + pkgs.inotify-tools + pkgs.niv + pkgs.treefmt + ] ++ frontend.buildInputs + ) + ).env.overrideAttrs ( + old: { + shellHook = '' + ln -snfv ${bootstrap} ${builtins.toString ./.}/static/bootstrap.css + ln -snfv ${d3} ${builtins.toString ./.}/static/d3.js + ''; + } + ); +} diff --git a/frontend/default.nix b/frontend/default.nix index f12469e..eba9da3 100644 --- a/frontend/default.nix +++ b/frontend/default.nix @@ -5,34 +5,34 @@ , nodePackages }: let - versionsDat = ./versions.dat; srcs = ./elm-srcs.nix; in - stdenvNoCC.mkDerivation { - name = "grafanix"; +stdenvNoCC.mkDerivation { + name = "grafanix"; - src = lib.sourceByRegex ./. [ - "src(.*elm)?" - "elm.json" - "build.sh" - ]; + src = lib.sourceByRegex ./. [ + "src(.*elm)?" + "elm.json" + "build.sh" + ]; - buildInputs = [ - elmPackages.elm - nodePackages.uglify-js - ] ++ lib.optionals lib.inNixShell [ - elm2nix - elmPackages.elm-format - ]; + buildInputs = [ + elmPackages.elm + nodePackages.uglify-js + ] ++ lib.optionals lib.inNixShell [ + elm2nix + elmPackages.elm-format + ]; - buildPhase = elmPackages.fetchElmDeps { - elmPackages = import srcs; - inherit versionsDat; - }; + buildPhase = elmPackages.fetchElmDeps { + elmPackages = import srcs; + elmVersion = "0.19.1"; + registryDat = ./registry.dat; + }; - installPhase = '' - mkdir -p $out - ${scripts/build.sh} src/Main.elm - cp elm.min.js $out/main.js - ''; - } + installPhase = '' + mkdir -p $out + ${scripts/build.sh} src/Main.elm + cp elm.min.js $out/main.js + ''; +} diff --git a/frontend/elm-srcs.nix b/frontend/elm-srcs.nix index 77cee3e..26173d5 100644 --- a/frontend/elm-srcs.nix +++ b/frontend/elm-srcs.nix @@ -1,62 +1,62 @@ { - "rundis/elm-bootstrap" = { - sha256 = "0jn864353vbq6q73gmycbcncm26a9v0mkb6ba75ab611sq7pc5kb"; - version = "5.1.0"; - }; - - "elm/browser" = { - sha256 = "1zlmx672glg7fdgkvh5jm47y85pv7pdfr5mkhg6x7ar6k000vyka"; - version = "1.0.1"; - }; - - "elm/core" = { - sha256 = "1l0qdbczw91kzz8sx5d5zwz9x662bspy7p21dsr3f2rigxiix2as"; - version = "1.0.2"; - }; - - "elm/http" = { - sha256 = "008bs76mnp48b4dw8qwjj4fyvzbxvlrl4xpa2qh1gg2kfwyw56v1"; - version = "2.0.0"; - }; - - "elm/bytes" = { - sha256 = "02ywbf52akvxclpxwj9n04jydajcbsbcbsnjs53yjc5lwck3abwj"; - version = "1.0.8"; - }; - - "elm/file" = { - sha256 = "1rljcb41dl97myidyjih2yliyzddkr2m7n74x7gg46rcw4jl0ny8"; - version = "1.0.5"; - }; - - "elm/json" = { - sha256 = "0kjwrz195z84kwywaxhhlnpl3p251qlbm5iz6byd6jky2crmyqyh"; - version = "1.1.3"; - }; - - "elm/html" = { - sha256 = "1n3gpzmpqqdsldys4ipgyl1zacn0kbpc3g4v3hdpiyfjlgh8bf3k"; - version = "1.0.0"; - }; - - "avh4/elm-color" = { - sha256 = "0n16wnvp87x9az3m5qjrl6smsg7051m719xn5d244painx8xmpzq"; - version = "1.0.0"; - }; - - "elm/url" = { - sha256 = "0av8x5syid40sgpl5vd7pry2rq0q4pga28b4yykn9gd9v12rs3l4"; - version = "1.0.0"; - }; - - "elm/time" = { - sha256 = "0vch7i86vn0x8b850w1p69vplll1bnbkp8s383z7pinyg94cm2z1"; - version = "1.0.0"; - }; - - "elm/virtual-dom" = { - sha256 = "0q1v5gi4g336bzz1lgwpn5b1639lrn63d8y6k6pimcyismp2i1yg"; - version = "1.0.2"; - }; + "rundis/elm-bootstrap" = { + sha256 = "0jn864353vbq6q73gmycbcncm26a9v0mkb6ba75ab611sq7pc5kb"; + version = "5.1.0"; + }; + + "elm/browser" = { + sha256 = "1zlmx672glg7fdgkvh5jm47y85pv7pdfr5mkhg6x7ar6k000vyka"; + version = "1.0.1"; + }; + + "elm/core" = { + sha256 = "1l0qdbczw91kzz8sx5d5zwz9x662bspy7p21dsr3f2rigxiix2as"; + version = "1.0.2"; + }; + + "elm/http" = { + sha256 = "008bs76mnp48b4dw8qwjj4fyvzbxvlrl4xpa2qh1gg2kfwyw56v1"; + version = "2.0.0"; + }; + + "elm/bytes" = { + sha256 = "02ywbf52akvxclpxwj9n04jydajcbsbcbsnjs53yjc5lwck3abwj"; + version = "1.0.8"; + }; + + "elm/file" = { + sha256 = "1rljcb41dl97myidyjih2yliyzddkr2m7n74x7gg46rcw4jl0ny8"; + version = "1.0.5"; + }; + + "elm/json" = { + sha256 = "0kjwrz195z84kwywaxhhlnpl3p251qlbm5iz6byd6jky2crmyqyh"; + version = "1.1.3"; + }; + + "elm/html" = { + sha256 = "1n3gpzmpqqdsldys4ipgyl1zacn0kbpc3g4v3hdpiyfjlgh8bf3k"; + version = "1.0.0"; + }; + + "avh4/elm-color" = { + sha256 = "0n16wnvp87x9az3m5qjrl6smsg7051m719xn5d244painx8xmpzq"; + version = "1.0.0"; + }; + + "elm/url" = { + sha256 = "0av8x5syid40sgpl5vd7pry2rq0q4pga28b4yykn9gd9v12rs3l4"; + version = "1.0.0"; + }; + + "elm/time" = { + sha256 = "0vch7i86vn0x8b850w1p69vplll1bnbkp8s383z7pinyg94cm2z1"; + version = "1.0.0"; + }; + + "elm/virtual-dom" = { + sha256 = "0q1v5gi4g336bzz1lgwpn5b1639lrn63d8y6k6pimcyismp2i1yg"; + version = "1.0.2"; + }; } diff --git a/frontend/elm.json b/frontend/elm.json index 8115c6d..e2fe09a 100644 --- a/frontend/elm.json +++ b/frontend/elm.json @@ -3,7 +3,7 @@ "source-directories": [ "src" ], - "elm-version": "0.19.0", + "elm-version": "0.19.1", "dependencies": { "direct": { "elm/browser": "1.0.1", diff --git a/frontend/registry.dat b/frontend/registry.dat new file mode 100644 index 0000000..b294427 Binary files /dev/null and b/frontend/registry.dat differ diff --git a/frontend/scripts/build.sh b/frontend/scripts/build.sh index 7e308aa..720b7a0 100755 --- a/frontend/scripts/build.sh +++ b/frontend/scripts/build.sh @@ -6,7 +6,7 @@ min="elm.min.js" elm make --optimize --output=$js $@ -uglifyjs $js --compress 'pure_funcs="F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9",pure_getters,keep_fargs=false,unsafe_comps,unsafe' | uglifyjs --mangle --output=$min +uglifyjs $js --compress 'pure_funcs="F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9",pure_getters,keep_fargs=false,unsafe_comps,unsafe' | uglifyjs --mangle --output $min echo "Compiled size: $(cat $js | wc -c) bytes ($js)" echo "Minified size: $(cat $min | wc -c) bytes ($min)" diff --git a/frontend/versions.dat b/frontend/versions.dat deleted file mode 100644 index d4dbe3a..0000000 Binary files a/frontend/versions.dat and /dev/null differ diff --git a/nix/grafanix-backend.nix b/nix/grafanix-backend.nix index 8844bf1..b5a3832 100644 --- a/nix/grafanix-backend.nix +++ b/nix/grafanix-backend.nix @@ -1,5 +1,5 @@ { mkDerivation -, stdenv +, lib , aeson , attoparsec @@ -11,7 +11,7 @@ , hashable , hspec , hspec-attoparsec -, lrucaching +, lrucache , optparse-applicative , protolude , scotty @@ -22,12 +22,13 @@ , wai-middleware-static , static ? false -, zlib +, ncurses ? null +, zlib ? null }: mkDerivation { pname = "grafanix-backend"; version = "0.1.0.0"; - src = stdenv.lib.sourceByRegex ../backend [ + src = lib.sourceByRegex ../backend [ "app" "app/.*\.hs" "src" @@ -43,9 +44,9 @@ mkDerivation { enableSharedLibraries = false; enableSharedExecutables = false; configureFlags = - stdenv.lib.optionals static [ + lib.optionals static [ "--ghc-option=-optl=-static" - "--extra-lib-dirs=${zlib.static}/lib" + "--extra-lib-dirs=${zlib.static}/lib:${ncurses}/lib" ]; executableHaskellDepends = [ @@ -57,7 +58,7 @@ mkDerivation { errors filepath hashable - lrucaching + lrucache optparse-applicative protolude scotty @@ -68,5 +69,5 @@ mkDerivation { wai-middleware-static ]; testHaskellDepends = [ base hspec hspec-attoparsec ]; - license = stdenv.lib.licenses.mit; + license = lib.licenses.mit; } diff --git a/nix/grafanix-release.nix b/nix/grafanix-release.nix index b408e42..3ec5415 100644 --- a/nix/grafanix-release.nix +++ b/nix/grafanix-release.nix @@ -5,7 +5,7 @@ let version = grafanix.version; in - runCommand "grafanix-${version}.zip" {} '' - cd ${grafanix} - ${zip}/bin/zip -9 -r $out * - '' \ No newline at end of file +runCommand "grafanix-${version}.zip" { } '' + cd ${grafanix} + ${zip}/bin/zip -9 -r $out * +'' diff --git a/nix/grafanix.nix b/nix/grafanix.nix index baa285c..61085fb 100644 --- a/nix/grafanix.nix +++ b/nix/grafanix.nix @@ -7,7 +7,7 @@ }: stdenvNoCC.mkDerivation { name = "grafanix"; - version = "0.2"; + version = "0.3"; src = lib.sourceByRegex ../static [ "drawGraph.js" diff --git a/nix/sources.json b/nix/sources.json index d180d33..b525526 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -1,51 +1,26 @@ { - "all-hies": { - "branch": "master", - "description": "Cached Haskell IDE Engine Nix builds for all GHC versions", - "homepage": "", - "owner": "Infinisil", - "repo": "all-hies", - "rev": "b06fdd252c71404ace1eea5e09b562bcf7f834f7", - "sha256": "1gzipcmhm6xbfjdjx3i4057vysmvrm6xykx9aplj3wcwmk3bhmdy", - "type": "tarball", - "url": "https://github.com/Infinisil/all-hies/archive/b06fdd252c71404ace1eea5e09b562bcf7f834f7.tar.gz", - "url_template": "https://github.com///archive/.tar.gz" - }, - "bootstrap": { - "sha256": "0dldiln2s3z8iqc5ccjid2i5gh9527naas064bwly8x9lrfrxcb0", - "type": "file", - "url": "https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/4.3.1/css/bootstrap.min.css", - "url_template": "https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap//css/bootstrap.min.css", - "version": "4.3.1" - }, - "d3": { - "sha256": "0mjblqriz0k8v9034sra5pz10ql3x8ysaril24if6w2pq0i2ci4v", - "type": "file", - "url": "https://cdnjs.cloudflare.com/ajax/libs/d3/5.15.0/d3.min.js", - "url_template": "https://cdnjs.cloudflare.com/ajax/libs/d3//d3.min.js", - "version": "5.15.0" - }, "niv": { "branch": "master", "description": "Easy dependency management for Nix projects", "homepage": "https://github.com/nmattia/niv", "owner": "nmattia", "repo": "niv", - "rev": "2ecfd86b631714b457e56d70dd83fa60435baeb6", - "sha256": "01j6727cws8blg1npp54b4w6xa0gpgyzhyws2vqgp8clnlnmqqhi", + "rev": "914aba08a26cb10538b84d00d6cfb01c9776d80c", + "sha256": "0gx316gc7prjay5b0cr13x4zc2pdbiwxkfkpjvrlb2rml80lm4pm", "type": "tarball", - "url": "https://github.com/nmattia/niv/archive/2ecfd86b631714b457e56d70dd83fa60435baeb6.tar.gz", + "url": "https://github.com/nmattia/niv/archive/914aba08a26cb10538b84d00d6cfb01c9776d80c.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "nixpkgs": { - "branch": "nixos-19.03", + "branch": "23.05", "description": "Nixpkgs/NixOS branches that track the Nixpkgs/NixOS channels", + "homepage": "https://github.com/NixOS/nixpkgs", "owner": "NixOS", - "repo": "nixpkgs-channels", - "rev": "7bb74e653654dbf9206e751574b5132b15f46bb5", - "sha256": "1dbdy4f58yqz4l67n032184rx7ci94hx3wl52c8h2bg06awkzq87", + "repo": "nixpkgs", + "rev": "4ecab3273592f27479a583fb6d975d4aba3486fe", + "sha256": "10wn0l08j9lgqcw8177nh2ljrnxdrpri7bp0g7nvrsn9rkawvlbf", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs-channels/archive/7bb74e653654dbf9206e751574b5132b15f46bb5.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/4ecab3273592f27479a583fb6d975d4aba3486fe.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "static-haskell-nix": { @@ -54,21 +29,10 @@ "homepage": "", "owner": "nh2", "repo": "static-haskell-nix", - "rev": "b06f8979bfaa27dc4ce76cbeaa393e0c28b5baef", - "sha256": "17f4if6rx7xhsfz1n9i151n7zxf82p08nmyml24fb1axi9j6ya38", - "type": "tarball", - "url": "https://github.com/nh2/static-haskell-nix/archive/b06f8979bfaa27dc4ce76cbeaa393e0c28b5baef.tar.gz", - "url_template": "https://github.com///archive/.tar.gz" - }, - "unstable": { - "branch": "nixos-unstable", - "description": "Nixpkgs/NixOS branches that track the Nixpkgs/NixOS channels", - "owner": "NixOS", - "repo": "nixpkgs-channels", - "rev": "beff2f8d75ef2c65017fb25e251337c6bb2e950d", - "sha256": "1av1m2mibv9dgfrjv9r8n3ih9dyb0wi594s5xb4c135v121jpzs3", + "rev": "88f1e2d57e3f4cd6d980eb3d8f99d5e60040ad54", + "sha256": "1hf1470r9axjzjjnl9k21drvwx7wfcalpj3k578yb3qz5j1lh5nk", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs-channels/archive/beff2f8d75ef2c65017fb25e251337c6bb2e950d.tar.gz", + "url": "https://github.com/nh2/static-haskell-nix/archive/88f1e2d57e3f4cd6d980eb3d8f99d5e60040ad54.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/nix/sources.nix b/nix/sources.nix index 6e2bf23..fe3dadf 100644 --- a/nix/sources.nix +++ b/nix/sources.nix @@ -6,83 +6,124 @@ let # The fetchers. fetch_ fetches specs of type . # - fetch_file = pkgs: spec: + fetch_file = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in if spec.builtin or true then - builtins_fetchurl { inherit (spec) url sha256; } + builtins_fetchurl { inherit (spec) url sha256; name = name'; } else - pkgs.fetchurl { inherit (spec) url sha256; }; + pkgs.fetchurl { inherit (spec) url sha256; name = name'; }; - fetch_tarball = pkgs: spec: + fetch_tarball = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in if spec.builtin or true then - builtins_fetchTarball { inherit (spec) url sha256; } + builtins_fetchTarball { name = name'; inherit (spec) url sha256; } else - pkgs.fetchzip { inherit (spec) url sha256; }; - - fetch_git = spec: - builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; }; + pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; - fetch_builtin-tarball = spec: - builtins.trace - '' - WARNING: - The niv type "builtin-tarball" will soon be deprecated. You should - instead use `builtin = true`. + fetch_git = name: spec: + let + ref = + spec.ref or ( + if spec ? branch then "refs/heads/${spec.branch}" else + if spec ? tag then "refs/tags/${spec.tag}" else + abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!" + ); + submodules = spec.submodules or false; + submoduleArg = + let + nixSupportsSubmodules = builtins.compareVersions builtins.nixVersion "2.4" >= 0; + emptyArgWithWarning = + if submodules + then + builtins.trace + ( + "The niv input \"${name}\" uses submodules " + + "but your nix's (${builtins.nixVersion}) builtins.fetchGit " + + "does not support them" + ) + { } + else { }; + in + if nixSupportsSubmodules + then { inherit submodules; } + else emptyArgWithWarning; + in + builtins.fetchGit + ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg); - $ niv modify -a type=tarball -a builtin=true - '' - builtins_fetchTarball { inherit (spec) url sha256; }; + fetch_local = spec: spec.path; - fetch_builtin-url = spec: - builtins.trace - '' - WARNING: - The niv type "builtin-url" will soon be deprecated. You should - instead use `builtin = true`. + fetch_builtin-tarball = name: throw + ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=tarball -a builtin=true''; - $ niv modify -a type=file -a builtin=true - '' - (builtins_fetchurl { inherit (spec) url sha256; }); + fetch_builtin-url = name: throw + ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=file -a builtin=true''; # # Various helpers # - # The set of packages used when specs are fetched using non-builtins. - mkPkgs = sources: - if hasNixpkgsPath - then - if hasThisAsNixpkgsPath - then import (builtins_fetchTarball { inherit (mkNixpkgs sources) url sha256; }) {} - else import {} - else - import (builtins_fetchTarball { inherit (mkNixpkgs sources) url sha256; }) {}; + # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695 + sanitizeName = name: + ( + concatMapStrings (s: if builtins.isList s then "-" else s) + ( + builtins.split "[^[:alnum:]+._?=-]+" + ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name) + ) + ); - mkNixpkgs = sources: + # The set of packages used when specs are fetched using non-builtins. + mkPkgs = sources: system: + let + sourcesNixpkgs = + import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; }; + hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; + hasThisAsNixpkgsPath = == ./.; + in if builtins.hasAttr "nixpkgs" sources - then sources.nixpkgs - else abort - '' - Please specify either (through -I or NIX_PATH=nixpkgs=...) or - add a package called "nixpkgs" to your sources.json. - ''; - - hasNixpkgsPath = (builtins.tryEval ).success; - hasThisAsNixpkgsPath = - (builtins.tryEval ).success && == ./.; + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import { } + else + abort + '' + Please specify either (through -I or NIX_PATH=nixpkgs=...) or + add a package called "nixpkgs" to your sources.json. + ''; # The actual fetching function. fetch = pkgs: name: spec: if ! builtins.hasAttr "type" spec then abort "ERROR: niv spec ${name} does not have a 'type' attribute" - else if spec.type == "file" then fetch_file pkgs spec - else if spec.type == "tarball" then fetch_tarball pkgs spec - else if spec.type == "git" then fetch_git spec - else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec - else if spec.type == "builtin-url" then fetch_builtin-url spec + else if spec.type == "file" then fetch_file pkgs name spec + else if spec.type == "tarball" then fetch_tarball pkgs name spec + else if spec.type == "git" then fetch_git name spec + else if spec.type == "local" then fetch_local spec + else if spec.type == "builtin-tarball" then fetch_builtin-tarball name + else if spec.type == "builtin-url" then fetch_builtin-url name else abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}"; + # If the environment variable NIV_OVERRIDE_${name} is set, then use + # the path directly as opposed to the fetched source. + replace = name: drv: + let + saneName = stringAsChars (c: if (builtins.match "[a-zA-Z0-9]" c) == null then "_" else c) name; + ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}"; + in + if ersatz == "" then drv else + # this turns the string into an actual Nix path (for both absolute and + # relative paths) + if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}"; + # Ports of functions for older nix versions # a Nix version of mapAttrs if the built-in doesn't exist @@ -91,42 +132,60 @@ let listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)) ); + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295 + range = first: last: if first > last then [ ] else builtins.genList (n: first + n) (last - first + 1); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257 + stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1)); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269 + stringAsChars = f: s: concatStrings (map f (stringToCharacters s)); + concatMapStrings = f: list: concatStrings (map f list); + concatStrings = builtins.concatStringsSep ""; + + # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331 + optionalAttrs = cond: as: if cond then as else { }; + # fetchTarball version that is compatible between all the versions of Nix - builtins_fetchTarball = { url, sha256 }@attrs: + builtins_fetchTarball = { url, name ? null, sha256 }@attrs: let inherit (builtins) lessThan nixVersion fetchTarball; in - if lessThan nixVersion "1.12" then - fetchTarball { inherit url; } - else - fetchTarball attrs; + if lessThan nixVersion "1.12" then + fetchTarball ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchTarball attrs; # fetchurl version that is compatible between all the versions of Nix - builtins_fetchurl = { url, sha256 }@attrs: + builtins_fetchurl = { url, name ? null, sha256 }@attrs: let inherit (builtins) lessThan nixVersion fetchurl; in - if lessThan nixVersion "1.12" then - fetchurl { inherit url; } - else - fetchurl attrs; + if lessThan nixVersion "1.12" then + fetchurl ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchurl attrs; # Create the final "sources" from the config mkSources = config: - mapAttrs ( - name: spec: - if builtins.hasAttr "outPath" spec - then abort - "The values in sources.json should not have an 'outPath' attribute" - else - spec // { outPath = fetch config.pkgs name spec; } - ) config.sources; + mapAttrs + ( + name: spec: + if builtins.hasAttr "outPath" spec + then + abort + "The values in sources.json should not have an 'outPath' attribute" + else + spec // { outPath = replace name (fetch config.pkgs name spec); } + ) + config.sources; # The "config" used by the fetchers mkConfig = - { sourcesFile ? ./sources.json - , sources ? builtins.fromJSON (builtins.readFile sourcesFile) - , pkgs ? mkPkgs sources + { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null + , sources ? if sourcesFile == null then { } else builtins.fromJSON (builtins.readFile sourcesFile) + , system ? builtins.currentSystem + , pkgs ? mkPkgs sources system }: rec { # The sources, i.e. the attribute set of spec name to spec inherit sources; @@ -134,5 +193,6 @@ let # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers inherit pkgs; }; + in -mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); } +mkSources (mkConfig { }) // { __functor = _: settings: mkSources (mkConfig settings); } diff --git a/shell.nix b/shell.nix index 0d9af5e..fbd4670 100644 --- a/shell.nix +++ b/shell.nix @@ -1 +1 @@ -(import ./. {}).shell +(import ./default.nix { }).shell diff --git a/treefmt.toml b/treefmt.toml new file mode 100644 index 0000000..d6772c8 --- /dev/null +++ b/treefmt.toml @@ -0,0 +1,12 @@ +[formatter.elm] +command = "elm-format" +options = ["--yes"] +includes = ["*.elm"] + +[formatter.haskell] +command = "ormolu" +includes = ["*.hs"] + +[formatter.nix] +command = "nixpkgs-fmt" +includes = ["*.nix"]