BrickApp.hs

module NixTree.BrickApp (run, helpText) where

import qualified Brick as B
import qualified Brick.BChan as B
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Center as B
import qualified Brick.Widgets.List as B
import Control.Concurrent
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Sequence as S
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Graphics.Vty as V
import Lens.Micro (Traversal', _1, _Just, (^.))
import qualified NixTree.Clipboard as Clipboard
import NixTree.Data.InvertedIndex
import NixTree.PathStats
import qualified System.Clock as Clock
import qualified System.HrfSize as HRF

sortOrderChangeHighlightPeriod :: Clock.TimeSpec
sortOrderChangeHighlightPeriod = Clock.TimeSpec 0 (500 * 1_000_000)

data Event
  = EventTick Clock.TimeSpec

data Widgets
  = WidgetPrevPane
  | WidgetCurrPane
  | WidgetNextPane
  | WidgetWhyDepends
  | WidgetSearch
  | WidgetWhyDependsViewport
  deriving (Show, Eq, Ord)

data Notice = Notice Text Text

data Modal s
  = ModalNotice Notice
  | ModalWhyDepends (B.GenericList Widgets Seq (NonEmpty Path))
  | ModalSearch Text Text (B.GenericList Widgets Seq Path)

succCycle :: forall a. (Bounded a, Enum a) => a -> a
succCycle a
  | fromEnum a == fromEnum (maxBound @a) = minBound
  | otherwise = succ a

data AppEnv s = AppEnv
  { aeActualStoreEnv :: StoreEnv PathStats,
    aeInvertedIndex :: InvertedIndex Path,
    aePrevPane :: List,
    aeCurrPane :: List,
    aeNextPane :: List,
    aeParents :: [List],
    aeOpenModal :: Maybe (Modal s),
    aeSortOrder :: SortOrder,
    aeSortOrderLastChanged :: Clock.TimeSpec,
    aeCurrTime :: Clock.TimeSpec
  }

type Path = StorePath StoreName PathStats

type List = B.GenericList Widgets Seq Path

data SortOrder
  = SortOrderAlphabetical
  | SortOrderClosureSize
  | SortOrderAddedSize
  deriving (Show, Eq, Enum, Bounded)

B.suffixLenses ''AppEnv

_ModalWhyDepends :: Traversal' (Modal s) (B.GenericList Widgets Seq (NonEmpty Path))
_ModalWhyDepends f m = case m of
  ModalWhyDepends l -> ModalWhyDepends <$> f l
  _ -> pure m

compareBySortOrder :: SortOrder -> Path -> Path -> Ordering
compareBySortOrder SortOrderAlphabetical = compare `on` T.toLower . storeNameToShortText . spName
compareBySortOrder SortOrderClosureSize = compare `on` Down . psTotalSize . spPayload
compareBySortOrder SortOrderAddedSize = compare `on` Down . psAddedSize . spPayload

attrTerminal, attrUnderlined :: B.AttrName
attrTerminal = B.attrName "terminal"
attrUnderlined = B.attrName "underlined"

run :: StoreEnv PathStats -> IO ()
run env = do
  -- Create the inverted index, and start evaluating it in the background
  let ii = iiFromList . toList . fmap (\sp -> (storeNameToText (spName sp), sp)) $ seAll env
  _ <- forkIO $ evaluateNF_ ii

  -- Initial state
  let getTime = Clock.getTime Clock.Monotonic
  currTime <- getTime
  let defaultSortOrder = SortOrderClosureSize

  let appEnv =
        AppEnv
          { aeActualStoreEnv =
              env,
            aeInvertedIndex =
              ii,
            aePrevPane =
              B.list WidgetPrevPane S.empty 0,
            aeCurrPane =
              B.list
                WidgetCurrPane
                (S.fromList . sortBy (compareBySortOrder defaultSortOrder) . NE.toList $ seGetRoots env)
                0,
            aeNextPane =
              B.list WidgetNextPane S.empty 0,
            aeParents =
              [],
            aeOpenModal =
              Nothing,
            aeSortOrder =
              defaultSortOrder,
            aeSortOrderLastChanged =
              Clock.TimeSpec 0 0,
            aeCurrTime =
              currTime
          }
          & repopulateNextPane

  -- Create a channel that's fed by current time
  chan <- B.newBChan 10
  void . forkIO $
    forever $ do
      threadDelay (100 * 1000)
      t <- getTime
      _ <- B.writeBChanNonBlocking chan (EventTick t)
      return ()

  -- And run the application
  (_, vty) <- B.customMainWithDefaultVty (Just chan) app appEnv
  V.shutdown vty

  return ()

renderList ::
  Maybe SortOrder ->
  Bool ->
  List ->
  B.Widget Widgets
renderList highlightSort =
  B.renderList
    ( \_
       StorePath
         { spName,
           spPayload = PathStats {psTotalSize, psAddedSize, psDisambiguationChars},
           spRefs,
           spSignatures
         } ->
          let color =
                if null spRefs
                  then B.withAttr attrTerminal
                  else identity
           in color $
                B.hBox
                  [ if null spSignatures
                      then B.txt "  "
                      else B.txt "✓ ",
                    B.txt (storeNameToShortTextWithDisambiguation psDisambiguationChars spName)
                      & underlineWhen SortOrderAlphabetical
                      & B.padRight (B.Pad 1)
                      & B.padRight B.Max,
                    if null spRefs
                      then
                        B.txt (prettySize psTotalSize)
                          & underlineWhen SortOrderClosureSize
                          & underlineWhen SortOrderAddedSize
                      else
                        B.hBox
                          [ B.txt (prettySize psTotalSize)
                              & underlineWhen SortOrderClosureSize,
                            B.txt " (",
                            B.txt (prettySize psAddedSize)
                              & underlineWhen SortOrderAddedSize,
                            B.txt ")"
                          ]
                  ]
    )
  where
    underlineWhen so =
      if Just so == highlightSort
        then B.withDefAttr attrUnderlined
        else identity

app :: B.App (AppEnv s) Event Widgets
app =
  B.App
    { B.appDraw = \env@AppEnv {aeOpenModal} ->
        [ case aeOpenModal of
            Nothing -> B.emptyWidget
            Just (ModalWhyDepends l) -> renderWhyDependsModal l
            Just (ModalSearch l r xs) -> renderSearchModal l r xs
            Just (ModalNotice notice) -> renderNotice notice,
          renderMainScreen env
        ],
      B.appChooseCursor = \_ _ -> Nothing,
      B.appHandleEvent = \e -> do
        s <- get
        case (e, aeOpenModal s) of
          -- main screen
          (B.VtyEvent (V.EvKey k []), Nothing)
            | k `elem` [V.KChar 'q', V.KEsc] ->
                B.halt
          (B.VtyEvent (V.EvKey (V.KChar '?') []), Nothing) ->
            put s {aeOpenModal = Just (ModalNotice helpNotice)}
          (B.VtyEvent (V.EvKey (V.KChar 'w') []), Nothing) -> do
            B.hScrollToBeginning (B.viewportScroll WidgetWhyDependsViewport)
            modify showWhyDepends
          (B.VtyEvent (V.EvKey (V.KChar '/') []), Nothing) ->
            modify $ showAndUpdateSearch "" ""
          (B.VtyEvent (V.EvKey (V.KChar 'y') []), Nothing) -> do
            liftIO (yankToClipboard $ spName (selectedPath s))
              >>= \case
                Right () -> return ()
                Left n -> put s {aeOpenModal = Just (ModalNotice n)}
          (B.VtyEvent (V.EvKey (V.KChar 's') []), Nothing) ->
            put $
              s
                { aeSortOrder = succCycle (aeSortOrder s),
                  aeSortOrderLastChanged = aeCurrTime s
                }
                & sortPanes
          (B.VtyEvent (V.EvKey k []), Nothing)
            | k `elem` [V.KChar 'h', V.KLeft] ->
                modify moveLeft
          (B.VtyEvent (V.EvKey k []), Nothing)
            | k `elem` [V.KChar 'j', V.KDown, V.KChar '\t'] ->
                move B.listMoveDown
          (B.VtyEvent (V.EvKey k []), Nothing)
            | k `elem` [V.KChar 'k', V.KUp, V.KBackTab] ->
                move B.listMoveUp
          (B.VtyEvent (V.EvKey k []), Nothing)
            | k `elem` [V.KChar 'l', V.KRight] ->
                modify moveRight
          (B.VtyEvent (V.EvKey V.KPageUp []), Nothing) ->
            moveF B.listMovePageUp
          (B.VtyEvent (V.EvKey V.KPageDown []), Nothing) ->
            moveF B.listMovePageDown
          -- why-depends modal
          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))
            | k `elem` [V.KChar 'q', V.KEsc] ->
                put s {aeOpenModal = Nothing}
          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))
            | k `elem` [V.KChar 'h', V.KLeft] ->
                B.hScrollBy (B.viewportScroll WidgetWhyDependsViewport) (-1)
          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))
            | k `elem` [V.KChar 'j', V.KDown, V.KChar '\t'] ->
                put s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveDown l)}
          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))
            | k `elem` [V.KChar 'k', V.KUp, V.KBackTab] ->
                put s {aeOpenModal = Just $ ModalWhyDepends (B.listMoveUp l)}
          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))
            | k `elem` [V.KChar 'l', V.KRight] ->
                B.hScrollBy (B.viewportScroll WidgetWhyDependsViewport) 1
          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends _))
            | k == V.KHome ->
                B.hScrollToBeginning (B.viewportScroll WidgetWhyDependsViewport)
          (B.VtyEvent (V.EvKey k []), Just (ModalWhyDepends l))
            | k == V.KEnd ->
                scrollToSelectedLineEnd l
          (B.VtyEvent (V.EvKey V.KPageUp []), Just (ModalWhyDepends _)) ->
            B.zoom (aeOpenModalL . _Just . _ModalWhyDepends) B.listMovePageUp
          (B.VtyEvent (V.EvKey V.KPageDown []), Just (ModalWhyDepends _)) ->
            B.zoom (aeOpenModalL . _Just . _ModalWhyDepends) B.listMovePageDown
          (B.VtyEvent (V.EvKey V.KEnter []), Just (ModalWhyDepends l)) ->
            let closed = s {aeOpenModal = Nothing}
             in case B.listSelectedElement l of
                  Nothing -> put closed
                  Just (_, path) -> put $ selectPath path closed
          -- search modal
          (B.VtyEvent (V.EvKey V.KEsc []), Just (ModalSearch {})) ->
            put s {aeOpenModal = Nothing}
          (B.VtyEvent (V.EvKey k []), Just (ModalSearch l r xs))
            | k `elem` [V.KDown, V.KChar '\t'] ->
                put s {aeOpenModal = Just $ ModalSearch l r (B.listMoveDown xs)}
          (B.VtyEvent (V.EvKey k []), Just (ModalSearch l r xs))
            | k `elem` [V.KUp, V.KBackTab] ->
                put s {aeOpenModal = Just $ ModalSearch l r (B.listMoveUp xs)}
          (B.VtyEvent (V.EvKey V.KLeft []), Just (ModalSearch l r xs)) ->
            put
              s
                { aeOpenModal =
                    Just $ ModalSearch (T.dropEnd 1 l) (T.takeEnd 1 l <> r) (B.listMoveUp xs)
                }
          (B.VtyEvent (V.EvKey V.KRight []), Just (ModalSearch l r xs)) ->
            put
              s
                { aeOpenModal =
                    Just $ ModalSearch (l <> T.take 1 r) (T.drop 1 r) (B.listMoveUp xs)
                }
          (B.VtyEvent (V.EvKey (V.KChar c) []), Just (ModalSearch l r _))
            | c `Set.member` allowedSearchChars ->
                modify (showAndUpdateSearch (l <> T.singleton c) r)
          (B.VtyEvent (V.EvKey V.KBS []), Just (ModalSearch l r _)) ->
            modify (showAndUpdateSearch (T.dropEnd 1 l) r)
          (B.VtyEvent (V.EvKey V.KEnter []), Just (ModalSearch _ _ xs)) ->
            let closed = s {aeOpenModal = Nothing}
             in case B.listSelectedElement xs of
                  Nothing -> put closed
                  Just (_, path) ->
                    put $
                      selectPath
                        (shortestPathTo (aeActualStoreEnv s) (spName path))
                        closed
          -- notices
          (B.VtyEvent (V.EvKey k []), Just (ModalNotice _))
            | k `elem` [V.KChar 'q', V.KEsc] ->
                put s {aeOpenModal = Nothing}
          -- handle our events
          (B.AppEvent (EventTick t), _) ->
            let new = s {aeCurrTime = t}
             in do
                  put new
                  unless (timePassedSinceSortOrderChange new <= sum (replicate 2 sortOrderChangeHighlightPeriod)) B.continueWithoutRedraw
          -- ignore otherwise
          _ ->
            return (),
      B.appStartEvent = return (),
      B.appAttrMap = \_ ->
        B.attrMap
          V.defAttr
          [ (B.listSelectedFocusedAttr, V.currentAttr `V.withStyle` V.reverseVideo),
            (attrTerminal, B.fg V.blue),
            (attrUnderlined, V.currentAttr `V.withStyle` V.underline)
          ]
    }
  where
    allowedSearchChars :: Set Char
    allowedSearchChars =
      Set.fromList
        ( mconcat
            [ ['a' .. 'z'],
              ['A' .. 'Z'],
              ['0' .. '9'],
              "+-.=?_"
            ]
        )

yankToClipboard :: StoreName -> IO (Either Notice ())
yankToClipboard p =
  Clipboard.copy (toText $ storeNameToPath p)
    <&> \case
      Right () -> Right ()
      Left errs ->
        Left $
          Notice
            "Error"
            ( T.intercalate "\n" $
                "Cannot copy to clipboard: "
                  : map ("  " <>) errs
                  ++ ["Please report this as a bug."]
            )

timePassedSinceSortOrderChange :: AppEnv s -> Clock.TimeSpec
timePassedSinceSortOrderChange env = Clock.diffTimeSpec (aeCurrTime env) (aeSortOrderLastChanged env)

renderMainScreen :: AppEnv s -> B.Widget Widgets
renderMainScreen env@AppEnv {aePrevPane, aeCurrPane, aeNextPane} =
  (B.joinBorders . B.border)
    ( B.hBox
        [ renderList Nothing True aePrevPane,
          B.vBorder,
          renderList shouldHighlightSortOrder True aeCurrPane,
          B.vBorder,
          renderList Nothing False aeNextPane
        ]
    )
    B.<=> renderInfoPane env
  where
    shouldHighlightSortOrder =
      if timePassedSinceSortOrderChange env < sortOrderChangeHighlightPeriod
        then Just (aeSortOrder env)
        else Nothing

renderInfoPane :: AppEnv s -> B.Widget Widgets
renderInfoPane env =
  let selected = selectedPath env
      immediateParents = psImmediateParents $ spPayload selected
      signatures = spSignatures selected
   in B.vBox
        [ let (f, s) = storeNameToSplitShortText (spName selected)
           in B.txt f B.<+> underlineWhen SortOrderAlphabetical (B.txt s),
          [ B.txt $ "NAR Size: " <> prettySize (spSize selected),
            underlineWhen SortOrderClosureSize . B.txt $ "Closure Size: " <> prettySize (psTotalSize $ spPayload selected),
            underlineWhen SortOrderAddedSize . B.txt $ "Added Size: " <> prettySize (psAddedSize $ spPayload selected)
          ]
            & intersperse (B.txt " | ")
            & B.hBox,
          B.txt $
            "Signatures: "
              <> if null signatures
                then "✗"
                else
                  ( signatures
                      & map npsKeyName
                      & T.intercalate ", "
                  ),
          B.txt $
            if null immediateParents
              then "Immediate Parents: -"
              else
                "Immediate Parents ("
                  <> T.pack (show $ length immediateParents)
                  <> "): "
                  <> T.intercalate ", " (map storeNameToShortText immediateParents)
        ]
  where
    underlineWhen so =
      if so == aeSortOrder env
        then B.withAttr attrUnderlined
        else identity

renderModal :: Text -> B.Widget a -> B.Widget a
renderModal title widget =
  widget
    & B.borderWithLabel (B.txt title)
    & B.hLimitPercent 90
    & B.vLimitPercent 60
    & B.centerLayer

helpText :: Text
helpText =
  T.intercalate
    "\n"
    [ "hjkl/Arrow Keys : Navigate",
      "w               : Open why-depends modal",
      "/               : Open search modal",
      "s               : Change sort order",
      "y               : Yank selected path to clipboard",
      "?               : Show help",
      "q/Esc           : Quit / close modal"
    ]

helpNotice :: Notice
helpNotice = Notice "Help" helpText

renderNotice :: Notice -> B.Widget a
renderNotice (Notice title txt) = renderModal title (B.txt txt)

renderWhyDependsModal ::
  B.GenericList Widgets Seq (NonEmpty Path) ->
  B.Widget Widgets
renderWhyDependsModal l =
  B.renderList renderDepends True l
    & B.hLimitPercent 100 -- This limit seems pointless, but otherwise render list takes infinite
    -- amount of horizontal space and 'viewport' below complains.
    & B.viewport WidgetWhyDependsViewport B.Horizontal
    & renderModal "why-depends"
  where
    renderDepends _ =
      B.txt . whyDependsPathToText

whyDependsPathToText :: NonEmpty Path -> Text
whyDependsPathToText xs =
  xs
    & NE.toList
    & fmap (storeNameToShortText . spName)
    & T.intercalate " → "

{- We could use 'B.hScrollToEnd', but it jumps too much when some lines are longer than others.
This is more fine grained in that it jumps only to the end of the currently selected line.
-}
scrollToSelectedLineEnd ::
  B.GenericList Widgets Seq (NonEmpty Path) ->
  B.EventM Widgets (AppEnv s) ()
scrollToSelectedLineEnd l = do
  mViewport <- B.lookupViewport WidgetWhyDependsViewport
  case (mViewport, B.listSelectedElement l) of
    (Just vp, Just (_, selectedPath')) -> do
      let textWidth = B.textWidth (whyDependsPathToText selectedPath')
          viewportWidth = vp ^. B.vpSize . _1
          currentScroll = vp ^. B.vpLeft
          -- Calculate the scroll position needed to right-align the selected line
          -- We want: scrollPos + viewportWidth >= textWidth
          -- So: scrollPos = textWidth - viewportWidth (but not less than 0)
          targetScroll = max 0 (textWidth - viewportWidth)
          scrollDelta = targetScroll - currentScroll
      B.hScrollBy (B.viewportScroll WidgetWhyDependsViewport) scrollDelta
    _ -> pass

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)
    }

renderSearchModal :: Text -> Text -> B.GenericList Widgets Seq Path -> B.Widget Widgets
renderSearchModal left right l =
  renderModal "Search" window
  where
    window =
      B.txt left
        B.<+> B.txt "|"
        B.<+> B.txt right
        B.<=> B.hBorder
        B.<=> renderList Nothing True l

showAndUpdateSearch :: Text -> Text -> AppEnv s -> AppEnv s
showAndUpdateSearch left right env@AppEnv {aeInvertedIndex} =
  env {aeOpenModal = Just $ ModalSearch left right results}
  where
    results =
      let xs =
            iiSearch (left <> right) aeInvertedIndex
              & Map.elems
              & S.fromList
       in B.list WidgetSearch xs 1

move :: (List -> List) -> B.EventM n (AppEnv s) ()
move = moveF . modify

moveF :: B.EventM n List () -> B.EventM n (AppEnv s) ()
moveF f = do
  B.zoom aeCurrPaneL f
  modify repopulateNextPane

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, aeSortOrder} =
  let ref = selectedPath env
   in env
        { aeNextPane =
            B.listReplace
              ( S.sortBy (compareBySortOrder aeSortOrder)
                  . S.fromList
                  . map (seLookup aeActualStoreEnv)
                  $ spRefs ref
              )
              (Just 0)
              aeNextPane
        }

sortPane :: SortOrder -> List -> List
sortPane so l =
  let selected = B.listSelectedElement l
      elems =
        B.listElements l
          & S.sortBy (compareBySortOrder so)
      name = B.getName l
   in mkList so name elems (snd <$> selected)

sortPanes :: AppEnv s -> AppEnv s
sortPanes env@AppEnv {aeParents, aePrevPane, aeCurrPane, aeNextPane, aeSortOrder} =
  env
    { aeCurrPane = sortPane aeSortOrder aeCurrPane,
      aeNextPane = sortPane aeSortOrder aeNextPane,
      aeParents = sortPane aeSortOrder <$> aeParents,
      aePrevPane = sortPane aeSortOrder aePrevPane
    }

selectedPath :: AppEnv s -> Path
selectedPath = NE.head . selectedPaths

selectedPaths :: AppEnv s -> NonEmpty Path
selectedPaths AppEnv {aePrevPane, aeCurrPane, aeParents} =
  let parents =
        mapMaybe
          (fmap snd . B.listSelectedElement)
          (aePrevPane : aeParents)
   in case B.listSelectedElement aeCurrPane of
        Nothing -> error "invariant violation: no selected element"
        Just (_, p) -> p :| parents

selectPath :: NonEmpty Path -> 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 (aeSortOrder env) WidgetPrevPane (S.fromList possible) (Just 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
    emptyPane =
      B.list WidgetPrevPane S.empty 0

mkList ::
  SortOrder ->
  n ->
  Seq Path ->
  Maybe Path ->
  B.GenericList n Seq Path
mkList sortOrder name possible selected =
  let contents = S.sortBy (compareBySortOrder sortOrder) possible
   in B.list name contents 1
        & B.listMoveTo
          (fromMaybe 0 $ selected >>= \s -> ((==) `on` spName) s `S.findIndexL` contents)

-- 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"