Fixes, nixpkgs upgrade, formatting

.envrc

@@ -0,0 +1,2 @@
+use nix
+

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
+```

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)

backend/grafanix.cabal

@@ -22,7 +22,7 @@ library grafanix-internal
                       , containers
                       , errors
                       , hashable
-                      , lrucaching
+                      , lrucache
                       , optparse-applicative
                       , protolude
                       , text

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)

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)