diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,40 @@
+# nixdu
+
+Interactively browse the dependency graph of your Nix derivations.
+
+[![asciicast](https://asciinema.org/a/XVVOPQuU6ZQ0vGuO8ejr4JB11.svg)](https://asciinema.org/a/XVVOPQuU6ZQ0vGuO8ejr4JB11)
+
+## Installation
+
+```
+nix-env -iA nixdu -f https://github.com/utdemir/nixdu/archive/master.tar.gz
+```
+
+A nixpkgs overlay is also provided via `overlay.nix`, that can be used
+with tools like [home-manager][]:
+
+```nix
+nixpkgs.overlays = [
+  (let url = https://github.com/utdemir/nixdu/archive/master.tar.gz;
+    in import "${builtins.fetchTarball url}/overlay.nix" {})
+];
+
+home.packages = [ pkgs.nixdu ];
+```
+
+## Usage
+
+```
+$ nixdu --help
+nixdu --help
+Usage: nixdu [paths] [-h|--help]
+  Paths default to $HOME/.nix-profile and /var/run/current-system.
+Keybindings:
+  hjkl/Arrow Keys : Navigate
+  q/Esc:          : Quit / close modal
+  w               : Open why-depends mode
+  i               : Toggle modeline
+  ?               : Show help
+```
+
+[home-manager]: https://github.com/rycee/home-manager
diff --git a/nixdu.cabal b/nixdu.cabal
new file mode 100644
--- /dev/null
+++ b/nixdu.cabal
@@ -0,0 +1,40 @@
+name:                nixdu
+synopsis:            Interactively browse a Nix store paths dependencies
+description:         A terminal curses application to browse a Nix store paths dependencies
+version:             0.1.0.0
+homepage:            https://github.com/utdemir/nixdu
+license:             BSD3
+author:              Utku Demir
+maintainer:          Utku Demir
+copyright:           Utku Demir
+category:            Language.Nix
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md
+
+executable nixdu
+  main-is:            Main.hs
+  hs-source-dirs:     src
+  default-language:   Haskell2010
+  other-modules:      PathStats
+                      StorePath
+                      App
+  ghc-options:        -Wall -fno-warn-name-shadowing -threaded -O2 -threaded
+  build-depends:      base >= 4.11 && < 5
+                    , aeson
+                    , async
+                    , brick
+                    , containers
+                    , deepseq
+                    , directory
+                    , filepath
+                    , hashable
+                    , hrfsize
+                    , lens
+                    , parallel
+                    , protolude
+                    , text
+                    , transformers
+                    , typed-process
+                    , unordered-containers
+                    , vty
diff --git a/src/App.hs b/src/App.hs
new file mode 100644
--- /dev/null
+++ b/src/App.hs
@@ -0,0 +1,371 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module App (run, helpText) where
+
+import qualified Brick as B
+import qualified Brick.Widgets.Border as B
+import qualified Brick.Widgets.Center as B
+import qualified Brick.Widgets.List as B
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Sequence as S
+import qualified Data.Text as T
+import qualified Graphics.Vty as V
+import PathStats
+import Protolude
+import qualified System.HrfSize as HRF
+
+data Widgets
+  = WidgetPrevPane
+  | WidgetCurrPane
+  | WidgetNextPane
+  | WidgetWhyDepends
+  deriving (Show, Eq, Ord)
+
+data Modal s
+  = ModalHelp
+  | ModalWhyDepends (B.GenericList Widgets Seq (NonEmpty (Path s)))
+
+data AppEnv s = AppEnv
+  { aeActualStoreEnv :: StoreEnv s (PathStats s),
+    aePrevPane :: List s,
+    aeCurrPane :: List s,
+    aeNextPane :: List s,
+    aeParents :: [List s],
+    aeOpenModal :: Maybe (Modal s),
+    aeShowInfoPane :: Bool
+  }
+
+type Path s = StorePath s (StoreName s) (PathStats s)
+
+type List s = B.GenericList Widgets Seq (Path s)
+
+attrTerminal :: B.AttrName
+attrTerminal = "terminal"
+
+run :: StoreEnv s (PathStats s) -> IO ()
+run env = void $ B.defaultMain app appEnv
+  where
+    appEnv =
+      AppEnv
+        { aeActualStoreEnv =
+            env,
+          aePrevPane =
+            B.list WidgetPrevPane S.empty 0,
+          aeCurrPane =
+            B.list WidgetCurrPane (S.fromList . NE.toList $ seGetRoots env) 0,
+          aeNextPane =
+            B.list WidgetNextPane S.empty 0,
+          aeParents =
+            [],
+          aeOpenModal =
+            Nothing,
+          aeShowInfoPane =
+            True
+        }
+        & repopulateNextPane
+
+renderList ::
+  Bool ->
+  List s ->
+  B.Widget Widgets
+renderList isFocused list =
+  B.renderList
+    ( \_
+       StorePath
+         { spName,
+           spPayload = PathStats {psTotalSize, psAddedSize},
+           spRefs
+         } ->
+          let color =
+                if null spRefs
+                  then B.withAttr attrTerminal
+                  else identity
+           in color $
+                B.padRight B.Max (B.txt $ storeNameToShortText spName)
+                  B.<+> B.padLeft
+                    B.Max
+                    ( B.txt $
+                        prettySize psTotalSize
+                          <> if not (null spRefs)
+                            then
+                              " ("
+                                <> prettySize psAddedSize
+                                <> ")"
+                            else mempty
+                    )
+    )
+    isFocused
+    list
+
+app :: B.App (AppEnv s) () Widgets
+app =
+  B.App
+    { B.appDraw = \env@AppEnv {aeOpenModal} ->
+        [ case aeOpenModal of
+            Nothing -> B.emptyWidget
+            Just ModalHelp -> renderHelpModal
+            Just (ModalWhyDepends l) -> renderWhyDependsModal l,
+          renderMainScreen env
+        ],
+      B.appChooseCursor = \_ -> const Nothing,
+      B.appHandleEvent = \s e ->
+        case (e, aeOpenModal s) of
+          -- main screen
+          (B.VtyEvent (V.EvKey k []), Nothing)
+            | k `elem` [V.KChar 'q', V.KEsc] ->
+              B.halt s
+          (B.VtyEvent (V.EvKey (V.KChar '?') []), Nothing) ->
+            B.continue s {aeOpenModal = Just ModalHelp}
+          (B.VtyEvent (V.EvKey (V.KChar 'w') []), Nothing) ->
+            B.continue $ showWhyDepends s
+          (B.VtyEvent (V.EvKey (V.KChar 'i') []), Nothing) ->
+            B.continue $ s {aeShowInfoPane = not (aeShowInfoPane s)}
+          (B.VtyEvent (V.EvKey k []), Nothing)
+            | k `elem` [V.KChar 'h', V.KLeft] ->
+              B.continue $ moveLeft s
+          (B.VtyEvent (V.EvKey k []), Nothing)
+            | k `elem` [V.KChar 'j', V.KDown] ->
+              B.continue $ move B.listMoveDown s
+          (B.VtyEvent (V.EvKey k []), Nothing)
+            | k `elem` [V.KChar 'k', V.KUp] ->
+              B.continue $ move B.listMoveUp s
+          (B.VtyEvent (V.EvKey k []), Nothing)
+            | k `elem` [V.KChar 'l', V.KRight] ->
+              B.continue $ moveRight s
+          (B.VtyEvent (V.EvKey V.KPageUp []), Nothing) ->
+            B.continue =<< moveF B.listMovePageUp s
+          (B.VtyEvent (V.EvKey V.KPageDown []), Nothing) ->
+            B.continue =<< moveF B.listMovePageDown s
+          -- modals
+          (B.VtyEvent (V.EvKey k []), Just _)
+            | k `elem` [V.KChar 'q', V.KEsc] ->
+              B.continue s {aeOpenModal = Nothing}
+          -- why-depends modal
+          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))
+            | k `elem` [V.KChar 'j', V.KDown] ->
+              B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveDown l)}
+          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))
+            | k `elem` [V.KChar 'k', V.KUp] ->
+              B.continue s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveUp l)}
+          (B.VtyEvent (V.EvKey V.KPageUp []), Just (ModalWhyDepends l)) ->
+            B.listMovePageUp l >>= \l' ->
+              B.continue s {aeOpenModal = Just $ ModalWhyDepends l'}
+          (B.VtyEvent (V.EvKey V.KPageDown []), Just (ModalWhyDepends l)) ->
+            B.listMovePageDown l >>= \l' ->
+              B.continue s {aeOpenModal = Just $ ModalWhyDepends l'}
+          (B.VtyEvent (V.EvKey V.KEnter []), Just (ModalWhyDepends l)) ->
+            let closed = s {aeOpenModal = Nothing}
+             in case B.listSelectedElement l of
+                  Nothing -> B.continue closed
+                  Just (_, path) -> B.continue $ selectPath path closed
+          -- otherwise
+          _ ->
+            B.continue s,
+      B.appStartEvent = \s -> return s,
+      B.appAttrMap = \_ ->
+        B.attrMap
+          (V.white `B.on` V.black)
+          [ (B.listSelectedFocusedAttr, V.black `B.on` V.white),
+            (attrTerminal, B.fg V.blue)
+          ]
+    }
+
+renderMainScreen :: AppEnv s -> B.Widget Widgets
+renderMainScreen env@AppEnv {aePrevPane, aeCurrPane, aeNextPane, aeShowInfoPane} =
+  (B.joinBorders . B.border)
+    ( B.hBox
+        [ renderList True aePrevPane,
+          B.vBorder,
+          renderList True aeCurrPane,
+          B.vBorder,
+          renderList False aeNextPane
+        ]
+    )
+    B.<=> if aeShowInfoPane then renderInfoPane env else renderModeline env
+
+renderModeline :: AppEnv s -> B.Widget Widgets
+renderModeline env =
+  let selected = selectedPath env
+   in B.txt $
+        T.intercalate
+          " - "
+          [ T.pack $ storeNameToPath (spName selected),
+            "NAR Size: " <> prettySize (spSize selected),
+            "Closure Size: " <> prettySize (psTotalSize $ spPayload selected)
+          ]
+
+renderInfoPane :: AppEnv s -> B.Widget Widgets
+renderInfoPane env =
+  let selected = selectedPath env
+      immediateParents = psImmediateParents $ spPayload selected
+   in B.txt $
+        T.intercalate
+          "\n"
+          [ T.pack $ storeNameToPath (spName selected),
+            "NAR Size: " <> prettySize (spSize selected),
+            "Closure Size: " <> prettySize (psTotalSize $ spPayload selected),
+            if null immediateParents
+              then "Immediate Parents: -"
+              else
+                "Immediate Parents (" <> T.pack (show $ length immediateParents) <> "): "
+                  <> T.intercalate ", " (map storeNameToShortText immediateParents)
+          ]
+
+helpText :: Text
+helpText =
+  T.intercalate
+    "\n"
+    [ "hjkl/Arrow Keys : Navigate",
+      "q/Esc:          : Quit / close modal",
+      "w               : Open why-depends mode",
+      "i               : Toggle modeline",
+      "?               : Show help"
+    ]
+
+renderHelpModal :: B.Widget a
+renderHelpModal =
+  B.txt helpText
+    & B.borderWithLabel (B.txt "Help")
+    & B.hLimitPercent 90
+    & B.vLimitPercent 60
+    & B.centerLayer
+
+renderWhyDependsModal ::
+  B.GenericList Widgets Seq (NonEmpty (Path s)) ->
+  B.Widget Widgets
+renderWhyDependsModal l =
+  B.renderList renderDepends True l
+    & B.hLimitPercent 80
+    & B.vLimitPercent 60
+    & B.borderWithLabel (B.txt "why-depends")
+    & B.centerLayer
+  where
+    renderDepends _ =
+      B.txt . pathsToText
+    pathsToText xs =
+      xs
+        & NE.toList
+        & fmap (storeNameToShortText . spName)
+        & T.intercalate " → "
+
+showWhyDepends :: AppEnv s -> AppEnv s
+showWhyDepends env@AppEnv {aeActualStoreEnv} =
+  env
+    { aeOpenModal =
+        Just . ModalWhyDepends $
+          let selected = selectedPath env
+              route = selectedPaths env
+              xs = S.fromList $ whyDepends aeActualStoreEnv (spName selected)
+           in B.list WidgetWhyDepends xs 1
+                & B.listMoveTo
+                  (fromMaybe 0 $ (((==) `on` fmap spName) route) `S.findIndexL` xs)
+    }
+
+move :: (List s -> List s) -> AppEnv s -> AppEnv s
+move f = runIdentity . moveF (Identity . f)
+
+moveF :: Applicative f => (List s -> f (List s)) -> AppEnv s -> f (AppEnv s)
+moveF f env@AppEnv {aeCurrPane} =
+  repopulateNextPane . (\p -> env {aeCurrPane = p}) <$> f aeCurrPane
+
+moveLeft :: AppEnv s -> AppEnv s
+moveLeft env@AppEnv {aeParents = []} = env
+moveLeft env@AppEnv {aePrevPane, aeCurrPane, aeParents = parent : grandparents} =
+  env
+    { aeParents = grandparents,
+      aePrevPane = parent,
+      aeCurrPane = aePrevPane {B.listName = WidgetCurrPane},
+      aeNextPane = aeCurrPane {B.listName = WidgetNextPane}
+    }
+
+moveRight :: AppEnv s -> AppEnv s
+moveRight env@AppEnv {aePrevPane, aeCurrPane, aeNextPane, aeParents}
+  | null (B.listElements aeNextPane) = env
+  | otherwise =
+    env
+      { aePrevPane = aeCurrPane {B.listName = WidgetPrevPane},
+        aeCurrPane = aeNextPane {B.listName = WidgetCurrPane},
+        aeParents = aePrevPane : aeParents
+      }
+      & repopulateNextPane
+
+repopulateNextPane :: AppEnv s -> AppEnv s
+repopulateNextPane env@AppEnv {aeActualStoreEnv, aeNextPane} =
+  let ref = selectedPath env
+   in env
+        { aeNextPane =
+            B.listReplace
+              ( S.sortOn (Down . psTotalSize . spPayload)
+                  . S.fromList
+                  . map (seLookup aeActualStoreEnv)
+                  $ spRefs ref
+              )
+              (Just 0)
+              aeNextPane
+        }
+
+selectedPath :: AppEnv s -> Path s
+selectedPath = NE.head . selectedPaths
+
+selectedPaths :: AppEnv s -> NonEmpty (Path s)
+selectedPaths AppEnv {aePrevPane, aeCurrPane, aeParents} =
+  let parents =
+        mapMaybe
+          (fmap snd . B.listSelectedElement)
+          (aePrevPane : aeParents)
+   in case B.listSelectedElement aeCurrPane of
+        Nothing -> panic "invariant violation: no selected element"
+        Just (_, p) -> p :| parents
+
+selectPath :: NonEmpty (Path s) -> AppEnv s -> AppEnv s
+selectPath path env
+  | (spName <$> path) == (spName <$> selectedPaths env) =
+    env
+selectPath path env@AppEnv {aeActualStoreEnv} =
+  let root :| children = NE.reverse path
+      lists =
+        NE.scanl
+          ( \(_, prev) curr ->
+              ( map (seLookup aeActualStoreEnv) $
+                  spRefs prev,
+                curr
+              )
+          )
+          (NE.toList (seGetRoots aeActualStoreEnv), root)
+          children
+          & NE.reverse
+          & fmap
+            (\(possible, selected) -> mkList WidgetPrevPane possible selected)
+          & (<> (emptyPane :| []))
+   in case lists of
+        (curr :| prevs) ->
+          let (prev, parents) = case prevs of
+                [] -> (emptyPane, [])
+                p : ps -> (p, ps)
+           in env
+                { aeParents = parents,
+                  aePrevPane = prev,
+                  aeCurrPane = curr {B.listName = WidgetCurrPane}
+                }
+                & repopulateNextPane
+  where
+    mkList name possible selected =
+      let contents = S.sortOn (Down . psTotalSize . spPayload) (S.fromList possible)
+       in B.list name contents 1
+            & B.listMoveTo
+              (fromMaybe (0) $ (((==) `on` spName) selected) `S.findIndexL` contents)
+    emptyPane =
+      B.list WidgetPrevPane S.empty 0
+
+-- Utils
+
+prettySize :: Int -> T.Text
+prettySize size = case HRF.convertSize $ fromIntegral size of
+  HRF.Bytes d -> T.pack (show d)
+  HRF.KiB d -> T.pack (show d) <> " KiB"
+  HRF.MiB d -> T.pack (show d) <> " MiB"
+  HRF.GiB d -> T.pack (show d) <> " GiB"
+  HRF.TiB d -> T.pack (show d) <> " TiB"
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Main where
+
+import App
+import qualified Data.HashMap.Strict as HM
+import PathStats
+import Protolude
+import System.Directory (canonicalizePath, doesDirectoryExist, getHomeDirectory)
+import System.FilePath ((</>))
+
+usage :: Text
+usage =
+  unlines
+    [ "Usage: nixdu [paths] [-h|--help]",
+      "  Paths default to $HOME/.nix-profile and /var/run/current-system.",
+      "Keybindings:",
+      unlines . map ("  " <>) . lines $ helpText
+    ]
+
+usageAndFail :: Text -> IO a
+usageAndFail msg = do
+  hPutStrLn stderr $ "Error: " <> msg
+  hPutStr stderr usage
+  exitWith (ExitFailure 1)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  when (any (`elem` ["-h", "--help"]) args) $ do
+    putStr usage
+    exitWith ExitSuccess
+
+  paths <- case args of
+    p : ps ->
+      return $ p :| ps
+    [] -> do
+      home <- getHomeDirectory
+      roots <-
+        filterM
+          doesDirectoryExist
+          [ home </> ".nix-profile",
+            "/var/run/current-system"
+          ]
+      case roots of
+        [] -> usageAndFail "No store path given."
+        p : ps -> return $ p :| ps
+  storePaths <- mapM canonicalizePath paths
+  ret <- withStoreEnv storePaths $ \env' -> do
+    let env = calculatePathStats env'
+
+    -- Small hack to evaluate the tree branches with a breadth-first
+    -- traversal in the background
+    let go _ [] = return ()
+        go remaining nodes = do
+          let (newRemaining, foundNodes) =
+                foldl'
+                  ( \(nr, fs) n ->
+                      ( HM.delete n nr,
+                        HM.lookup n nr : fs
+                      )
+                  )
+                  (remaining, [])
+                  nodes
+          evaluate $ rnf foundNodes
+          go
+            newRemaining
+            (concatMap (maybe [] spRefs) foundNodes)
+    _ <- forkIO $ go (sePaths env) (toList $ seRoots env)
+
+    run env
+
+  case ret of
+    Right () -> return ()
+    Left err ->
+      usageAndFail $ "Not a store path: " <> show err
diff --git a/src/PathStats.hs b/src/PathStats.hs
new file mode 100644
--- /dev/null
+++ b/src/PathStats.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module PathStats
+  ( PathStats (..),
+    calculatePathStats,
+    markRouteTo,
+    whyDepends,
+    module StorePath,
+  )
+where
+
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Lazy as M
+import qualified Data.Set as S
+import Protolude
+import StorePath
+
+data IntermediatePathStats s = IntermediatePathStats
+  { ipsAllRefs :: M.Map (StoreName s) (StorePath s (StoreName s) ())
+  }
+
+data PathStats s = PathStats
+  { psTotalSize :: !Int,
+    psAddedSize :: !Int,
+    psImmediateParents :: [StoreName s]
+  }
+  deriving (Show, Generic, NFData)
+
+mkIntermediateEnv ::
+  (StoreName s -> Bool) ->
+  StoreEnv s () ->
+  StoreEnv s (IntermediatePathStats s)
+mkIntermediateEnv pred =
+  seBottomUp $ \curr ->
+    IntermediatePathStats
+      { ipsAllRefs =
+          M.unions
+            ( M.fromList
+                [ (spName, const () <$> sp)
+                  | sp@StorePath {spName} <- spRefs curr,
+                    pred spName
+                ]
+                : map (ipsAllRefs . spPayload) (spRefs curr)
+            )
+      }
+
+mkFinalEnv :: StoreEnv s (IntermediatePathStats s) -> StoreEnv s (PathStats s)
+mkFinalEnv env =
+  let totalSize = calculateEnvSize env
+      immediateParents = calculateImmediateParents (sePaths env)
+   in flip seBottomUp env $ \StorePath {spName, spSize, spPayload} ->
+        let filteredSize =
+              seFetchRefs env (/= spName) (seRoots env)
+                & calculateRefsSize
+            addedSize = totalSize - filteredSize
+         in PathStats
+              { psTotalSize =
+                  spSize
+                    + calculateRefsSize (ipsAllRefs spPayload),
+                psAddedSize = addedSize,
+                psImmediateParents =
+                  maybe [] S.toList $ M.lookup spName immediateParents
+              }
+  where
+    calculateEnvSize :: StoreEnv s (IntermediatePathStats s) -> Int
+    calculateEnvSize env =
+      seGetRoots env
+        & toList
+        & map
+          ( \sp@StorePath {spName, spPayload} ->
+              M.insert
+                spName
+                (const () <$> sp)
+                (ipsAllRefs spPayload)
+          )
+        & M.unions
+        & calculateRefsSize
+    calculateRefsSize :: (Functor f, Foldable f) => f (StorePath s a b) -> Int
+    calculateRefsSize = sum . fmap spSize
+    calculateImmediateParents ::
+      (Foldable f) =>
+      f (StorePath s (StoreName s) b) ->
+      M.Map (StoreName s) (S.Set (StoreName s))
+    calculateImmediateParents =
+      foldl'
+        ( \m StorePath {spName, spRefs} ->
+            M.unionWith
+              (<>)
+              m
+              (M.fromList (map (\r -> (r, S.singleton spName)) spRefs))
+        )
+        M.empty
+
+calculatePathStats :: StoreEnv s () -> StoreEnv s (PathStats s)
+calculatePathStats = mkFinalEnv . mkIntermediateEnv (const True)
+
+whyDepends :: StoreEnv s a -> StoreName s -> [NonEmpty (StorePath s (StoreName s) a)]
+whyDepends env name =
+  seBottomUp
+    ( \curr ->
+        if spName curr == name
+          then [curr {spRefs = map spName (spRefs curr)} :| []]
+          else
+            concat . transpose $
+              map
+                (map (curr {spRefs = map spName (spRefs curr)} NE.<|) . spPayload)
+                (spRefs curr)
+    )
+    env
+    & seGetRoots
+    & fmap spPayload
+    & concat
+    & map NE.reverse
+
+markRouteTo :: StoreName s -> StoreEnv s a -> StoreEnv s (Bool, a)
+markRouteTo name = seBottomUp $ \sp@StorePath {spName, spRefs} ->
+  ( spName == name || any (fst . spPayload) spRefs,
+    spPayload sp
+  )
diff --git a/src/StorePath.hs b/src/StorePath.hs
new file mode 100644
--- /dev/null
+++ b/src/StorePath.hs
@@ -0,0 +1,236 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module StorePath
+  ( StoreName (..),
+    storeNameToPath,
+    storeNameToText,
+    storeNameToShortText,
+    StorePath (..),
+    StoreEnv (..),
+    withStoreEnv,
+    seLookup,
+    seGetRoots,
+    seBottomUp,
+    seFetchRefs,
+  )
+where
+
+import Control.Monad (fail)
+import Data.Aeson ((.:), FromJSON (..), Value (..), decode)
+import qualified Data.HashMap.Strict as HM
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashSet as HS
+import qualified Data.Text as T
+import Protolude
+import System.FilePath.Posix (splitDirectories)
+import System.Process.Typed (proc, readProcessStdout_)
+
+--------------------------------------------------------------------------------
+
+newtype StoreName s = StoreName Text
+  deriving newtype (Show, Eq, Ord, Hashable, NFData)
+
+mkStoreName :: FilePath -> Maybe (StoreName a)
+mkStoreName path =
+  case splitDirectories path of
+    "/" : "nix" : "store" : name : _ -> Just . StoreName $ toS name
+    _ -> Nothing
+
+storeNameToText :: StoreName a -> Text
+storeNameToText (StoreName n) = n
+
+storeNameToPath :: StoreName a -> FilePath
+storeNameToPath (StoreName sn) = "/nix/store/" <> toS sn
+
+storeNameToShortText :: StoreName a -> Text
+storeNameToShortText = T.drop 1 . T.dropWhile (/= '-') . storeNameToText
+
+--------------------------------------------------------------------------------
+
+data StorePath s ref payload = StorePath
+  { spName :: StoreName s,
+    spSize :: Int,
+    spRefs :: [ref],
+    spPayload :: payload
+  }
+  deriving (Show, Eq, Ord, Functor, Generic)
+
+instance (NFData a, NFData b) => NFData (StorePath s a b)
+
+mkStorePaths :: NonEmpty (StoreName s) -> IO [StorePath s (StoreName s) ()]
+mkStorePaths names = do
+  infos <-
+    decode @[NixPathInfoResult]
+      <$> readProcessStdout_
+        ( proc
+            "nix"
+            ( ["path-info", "--recursive", "--json"]
+                ++ map storeNameToPath (toList names)
+            )
+        )
+      >>= maybe (fail "Failed parsing nix path-info output.") return
+      >>= mapM assertValidInfo
+  mapM infoToStorePath infos
+  where
+    infoToStorePath NixPathInfo {npiPath, npiNarSize, npiReferences} = do
+      name <- mkStoreNameIO npiPath
+      refs <- filter (/= name) <$> mapM mkStoreNameIO npiReferences
+      return $
+        StorePath
+          { spName = name,
+            spRefs = refs,
+            spSize = npiNarSize,
+            spPayload = ()
+          }
+    mkStoreNameIO p =
+      maybe
+        (fail $ "Failed parsing Nix store path: " ++ show p)
+        return
+        (mkStoreName p)
+    assertValidInfo (NixPathInfoValid pi) = return pi
+    assertValidInfo (NixPathInfoInvalid path) =
+      fail $ "Invalid path: " ++ path ++ ". Inconsistent /nix/store or ongoing GC."
+
+--------------------------------------------------------------------------------
+
+data StoreEnv s payload = StoreEnv
+  { sePaths :: HashMap (StoreName s) (StorePath s (StoreName s) payload),
+    seRoots :: NonEmpty (StoreName s)
+  }
+  deriving (Functor, Generic, NFData)
+
+withStoreEnv ::
+  forall m a.
+  MonadIO m =>
+  NonEmpty FilePath ->
+  (forall s. StoreEnv s () -> m a) ->
+  m (Either [FilePath] a)
+withStoreEnv fnames cb = do
+  let names' =
+        fnames
+          & toList
+          & map (\f -> maybe (Left f) Right (mkStoreName f))
+          & partitionEithers
+
+  case names' of
+    (errs@(_ : _), _) -> return (Left errs)
+    ([], xs) -> case nonEmpty xs of
+      Nothing -> panic "invariant violation"
+      Just names -> do
+        paths <- liftIO $ mkStorePaths names
+        let env =
+              StoreEnv
+                ( paths
+                    & map (\p@StorePath {spName} -> (spName, p))
+                    & HM.fromList
+                )
+                names
+        Right <$> cb env
+
+seLookup :: StoreEnv s a -> StoreName s -> StorePath s (StoreName s) a
+seLookup StoreEnv {sePaths} name =
+  fromMaybe
+    (panic $ "invariant violation, StoreName not found: " <> show name)
+    (HM.lookup name sePaths)
+
+seGetRoots :: StoreEnv s a -> NonEmpty (StorePath s (StoreName s) a)
+seGetRoots env@StoreEnv {seRoots} =
+  map (seLookup env) seRoots
+
+seFetchRefs ::
+  StoreEnv s a ->
+  (StoreName s -> Bool) ->
+  NonEmpty (StoreName s) ->
+  [StorePath s (StoreName s) a]
+seFetchRefs env predicate =
+  fst
+    . foldl'
+      (\(acc, visited) name -> go acc visited name)
+      ([], HS.empty)
+  where
+    go acc visited name
+      | HS.member name visited = (acc, visited)
+      | not (predicate name) = (acc, visited)
+      | otherwise =
+        let sp@StorePath {spRefs} = seLookup env name
+         in foldl'
+              (\(acc', visited') name' -> go acc' visited' name')
+              (sp : acc, HS.insert name visited)
+              spRefs
+
+seBottomUp ::
+  forall s a b.
+  (StorePath s (StorePath s (StoreName s) b) a -> b) ->
+  StoreEnv s a ->
+  StoreEnv s b
+seBottomUp f StoreEnv {sePaths, seRoots} =
+  StoreEnv
+    { sePaths = snd $ execState (mapM_ go seRoots) (sePaths, HM.empty),
+      seRoots
+    }
+  where
+    unsafeLookup k m =
+      fromMaybe
+        (panic $ "invariant violation: name doesn't exists: " <> show k)
+        (HM.lookup k m)
+    go ::
+      StoreName s ->
+      State
+        ( HashMap (StoreName s) (StorePath s (StoreName s) a),
+          HashMap (StoreName s) (StorePath s (StoreName s) b)
+        )
+        (StorePath s (StoreName s) b)
+    go name = do
+      bs <- gets snd
+      case name `HM.lookup` bs of
+        Just sp -> return sp
+        Nothing -> do
+          sp@StorePath {spName, spRefs} <- unsafeLookup name <$> gets fst
+          refs <- mapM go spRefs
+          let new = sp {spPayload = f sp {spRefs = refs}}
+          modify
+            ( \(as, bs) ->
+                ( HM.delete spName as,
+                  HM.insert spName new bs
+                )
+            )
+          return new
+
+--------------------------------------------------------------------------------
+
+data NixPathInfo = NixPathInfo
+  { npiPath :: FilePath,
+    npiNarSize :: Int,
+    npiReferences :: [FilePath]
+  }
+
+data NixPathInfoResult
+  = NixPathInfoValid NixPathInfo
+  | NixPathInfoInvalid FilePath
+
+instance FromJSON NixPathInfoResult where
+  parseJSON (Object obj) =
+    ( NixPathInfoValid
+        <$> ( NixPathInfo
+                <$> obj .: "path"
+                <*> obj .: "narSize"
+                <*> obj .: "references"
+            )
+    )
+      <|> ( do
+              path <- obj .: "path"
+              valid <- obj .: "valid"
+              guard (not valid)
+              return $ NixPathInfoInvalid path
+          )
+  parseJSON _ = fail "Expecting an object."