{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides types.
module Charon.Data.Index
  ( Index (..),
    empty,

    -- * Formatting
    formatIndex,
    Sort (..),
    readSort,

    -- * Low level utils
    formatIndex',
    fromList,
    insert,
  )
where

import Charon.Data.PathData (PathData)
import Charon.Data.PathData qualified as PathDataCore
import Charon.Data.PathData.Formatting
  ( ColFormat,
    Coloring (ColoringDetect, ColoringOff, ColoringOn),
    PathDataFormat (FormatMultiline, FormatSingleline, FormatTabular),
    Sort (Name, Size),
    readSort,
    _ColFormatFixed,
    _ColFormatMax,
  )
import Charon.Data.PathData.Formatting qualified as Formatting
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex (TrashEntryFileName, TrashEntryPath),
  )
import Charon.Prelude
import Charon.Runner.Command.List (ListCmdP2)
import Data.Foldable (toList)
import Data.HashMap.Strict qualified as HMap
import Data.List qualified as L
import Data.Ord (Ord (max))
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Effects.System.Terminal (getTerminalWidth)
import Effects.System.Terminal qualified as Term
import GHC.Real (RealFrac (floor))
import System.Console.Pretty (Color (Blue, Green, Magenta))

type PathDataCore = PathDataCore.PathData

-- | Index that stores the trash data.
newtype Index = MkIndex
  { Index -> Seq (PathData, PathI 'TrashEntryPath)
unIndex :: Seq (PathDataCore, PathI TrashEntryPath)
  }
  deriving stock (Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
/= :: Index -> Index -> Bool
Eq, (forall x. Index -> Rep Index x)
-> (forall x. Rep Index x -> Index) -> Generic Index
forall x. Rep Index x -> Index
forall x. Index -> Rep Index x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Index -> Rep Index x
from :: forall x. Index -> Rep Index x
$cto :: forall x. Rep Index x -> Index
to :: forall x. Rep Index x -> Index
Generic, Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
(Int -> Index -> ShowS)
-> (Index -> String) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Index -> ShowS
showsPrec :: Int -> Index -> ShowS
$cshow :: Index -> String
show :: Index -> String
$cshowList :: [Index] -> ShowS
showList :: [Index] -> ShowS
Show)
  deriving anyclass (Index -> ()
(Index -> ()) -> NFData Index
forall a. (a -> ()) -> NFData a
$crnf :: Index -> ()
rnf :: Index -> ()
NFData)

makeFieldLabelsNoPrefix ''Index

-- | Empty index.
empty :: Index
empty :: Index
empty = Seq (PathData, PathI 'TrashEntryPath) -> Index
MkIndex Seq (PathData, PathI 'TrashEntryPath)
forall a. Monoid a => a
mempty

-- | Formats the 'Index' in a pretty way.
formatIndex ::
  forall m.
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadLoggerNS m,
    MonadTerminal m
  ) =>
  -- | List config
  ListCmdP2 ->
  -- | The index to format
  Index ->
  m Text
formatIndex :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadLoggerNS m,
 MonadTerminal m) =>
ListCmdP2 -> Index -> m Text
formatIndex ListCmdP2
listCmd Index
idx =
  ListCmdP2 -> Seq PathData -> m Text
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadLoggerNS m,
 MonadTerminal m) =>
ListCmdP2 -> Seq PathData -> m Text
formatIndex' ListCmdP2
listCmd (Optic' A_Lens NoIx (PathData, PathI 'TrashEntryPath) PathData
-> (PathData, PathI 'TrashEntryPath) -> PathData
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (PathData, PathI 'TrashEntryPath) PathData
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((PathData, PathI 'TrashEntryPath) -> PathData)
-> Seq (PathData, PathI 'TrashEntryPath) -> Seq PathData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' An_Iso NoIx Index (Seq (PathData, PathI 'TrashEntryPath))
-> Index -> Seq (PathData, PathI 'TrashEntryPath)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx Index (Seq (PathData, PathI 'TrashEntryPath))
#unIndex Index
idx)

-- | Formats the 'Index' in a pretty way.
formatIndex' ::
  forall m.
  ( HasCallStack,
    MonadAsync m,
    MonadCatch m,
    MonadLoggerNS m,
    MonadTerminal m
  ) =>
  -- | List config
  ListCmdP2 ->
  -- | The index to format
  Seq PathDataCore ->
  m Text
formatIndex' :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadLoggerNS m,
 MonadTerminal m) =>
ListCmdP2 -> Seq PathData -> m Text
formatIndex' ListCmdP2
listCmd Seq PathData
idx = Text -> m Text -> m Text
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"formatIndex" (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ case ListCmdP2
listCmd ListCmdP2
-> Optic' A_Lens NoIx ListCmdP2 PathDataFormat -> PathDataFormat
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListCmdP2 PathDataFormat
#format of
  PathDataFormat
FormatMultiline ->
    Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ (PathData -> PathData -> Ordering) -> Seq PathData -> Text
multiline (Bool -> Sort -> PathData -> PathData -> Ordering
Formatting.sortFn (ListCmdP2
listCmd ListCmdP2 -> Optic' A_Lens NoIx ListCmdP2 Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListCmdP2 Bool
#revSort) (ListCmdP2
listCmd ListCmdP2 -> Optic' A_Lens NoIx ListCmdP2 Sort -> Sort
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListCmdP2 Sort
#sort)) Seq PathData
idx
  FormatSingleline Coloring
color -> do
    Bool
coloring <- Coloring -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Coloring -> m Bool
getColoring Coloring
color
    Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Bool -> Seq PathData -> Text
singleline Bool
coloring Seq PathData
idx
  FormatTabular Coloring
color Maybe ColFormat
nameFormat Maybe ColFormat
origFormat -> do
    Bool
coloring <- Coloring -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Coloring -> m Bool
getColoring Coloring
color

    -- We want to format the table such that we (concisely) display as
    -- much information as possible while trying to avoid ugly text wrapping
    -- (i.e. keep the table w/in the terminal width). This is complicated
    -- by the fact that fileNames / originalPath can be arbitrarily long,
    -- thus we have several heuristics.
    --
    -- First, background:
    --
    --   - The three fields pathType, size, and created all have a fixed length.
    --
    --   - The remaining two fields -- fileName and originalPath -- can be
    --     arbitrarily long but have a required minimum size.
    --
    --   - We try to automatically format the table within the terminal width,
    --     but provide options for overriding the fileName / originalPath
    --     lengths independently:
    --
    --       1. Set the column length to a specified length.
    --       2. Set the column length to the max row entry (e.g. longest
    --          fileName).
    --
    -- Now for the strategies:
    --
    --    1. If an option is explicitly set, use it, potential wrapping be
    --      damned. If the other field is unspecified, try to calculate the
    --      "best" option: i.e. one of the following strategies:
    --
    --        a. Use the max row entry if it fits within the terminal.
    --        b. If it doesn't fit, use remaining terminal space.
    --        c. If we don't have _any_ available space left -- according to the
    --           derived terminal space -- fallback to the required minimum.
    --
    --    2. If nothing is specified:
    --
    --       a. Try to display all data w/o truncation i.e. set each column
    --          to the max entry (e.g. longest fileName).
    --       b. If we cannot fit the maxes within the terminal width, use the
    --          remaining width according to the following ratio: 40% for
    --          fileNames, 60% for the originalPath.

    -- maxNameLen := longest name
    -- maxOrigLen := orig path
    (Natural
maxNameLen, Natural
maxOrigLen) <- (m (Natural, Natural) -> PathData -> m (Natural, Natural))
-> m (Natural, Natural) -> Seq PathData -> m (Natural, Natural)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' m (Natural, Natural) -> PathData -> m (Natural, Natural)
findMaxes ((Natural, Natural) -> m (Natural, Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural, Natural)
maxStart) Seq PathData
idx

    -- maxLen := maximum terminal width
    Natural
maxLen <- m Natural
forall (m :: * -> *).
(MonadCatch m, MonadLoggerNS m, MonadTerminal m) =>
m Natural
getTerminalLen

    -- maxLenForDynCols := available combined length for our dynamic
    -- columns (fileName + originalPath)
    Natural
maxLenForDynCols <-
      if Natural
maxLen Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
Formatting.minTableWidth
        then
          String -> m Natural
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString
            (String -> m Natural) -> String -> m Natural
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Terminal width (",
                Natural -> String
forall a. Show a => a -> String
show Natural
maxLen,
                String
") is less than minimum width (",
                Natural -> String
forall a. Show a => a -> String
show Natural
Formatting.minTableWidth,
                String
") for automatic tabular display.",
                String
" Perhaps try multiline."
              ]
        else Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> m Natural) -> Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ Natural
maxLen Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
Formatting.reservedLineLen

    -- Basically: if an option is explicitly specified; use it. Otherwise,
    -- try to calculate a "good" value.
    (Natural
nameLen, Natural
origLen) <- case ( Natural -> Maybe ColFormat -> Maybe Natural
fmtToStrategy Natural
maxNameLen Maybe ColFormat
nameFormat,
                                 Natural -> Maybe ColFormat -> Maybe Natural
fmtToStrategy Natural
maxOrigLen Maybe ColFormat
origFormat
                               ) of
      -- Both set, use them.
      (Just Natural
nLen, Just Natural
oLen) -> (Natural, Natural) -> m (Natural, Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural
nLen, Natural
oLen)
      -- nLen set -> derive oLen
      (Just Natural
nLen, Maybe Natural
Nothing) ->
        (Natural
nLen,) -- (nLen, derived oLen)
          (Natural -> (Natural, Natural))
-> m Natural -> m (Natural, Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Natural -> Natural -> Natural -> m Natural
forall (f :: * -> *).
MonadLoggerNS f =>
Natural -> Natural -> Natural -> Natural -> f Natural
mkDynamicLen
            Natural
maxLenForDynCols
            Natural
Formatting.formatOriginalPathLenMin
            Natural
maxOrigLen
            Natural
nLen
      -- oLen set -> derive nLen
      (Maybe Natural
Nothing, Just Natural
oLen) ->
        (,Natural
oLen) -- (derived nLen, oLen)
          (Natural -> (Natural, Natural))
-> m Natural -> m (Natural, Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Natural -> Natural -> Natural -> m Natural
forall (f :: * -> *).
MonadLoggerNS f =>
Natural -> Natural -> Natural -> Natural -> f Natural
mkDynamicLen
            Natural
maxLenForDynCols
            Natural
Formatting.formatFileNameLenMin
            Natural
maxNameLen
            Natural
oLen
      -- Neither set; Use both maxes if they fit, otherwise approx.
      (Maybe Natural
Nothing, Maybe Natural
Nothing) ->
        if Natural
maxNameLen Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
maxOrigLen Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxLenForDynCols
          then (Natural, Natural) -> m (Natural, Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural
maxNameLen, Natural
maxOrigLen)
          else
            let maxLenDynColsD :: Double
maxLenDynColsD = forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Double Natural
maxLenForDynCols
                nameApprox :: Natural
nameApprox = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max Natural
4 (Double -> Natural
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Natural) -> Double -> Natural
forall a b. (a -> b) -> a -> b
$ Double
maxLenDynColsD Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.4)
                origApprox :: Natural
origApprox = Natural
maxLenForDynCols Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
nameApprox
             in (Natural, Natural) -> m (Natural, Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural
nameApprox, Natural
origApprox)

    Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Bool
-> (PathData -> PathData -> Ordering)
-> Natural
-> Natural
-> Seq PathData
-> Text
tabular Bool
coloring (Bool -> Sort -> PathData -> PathData -> Ordering
Formatting.sortFn Bool
revSort Sort
sort) Natural
nameLen Natural
origLen Seq PathData
idx
    where
      -- Search the index; find the longest name and orig path
      findMaxes :: m (Natural, Natural) -> PathDataCore -> m (Natural, Natural)
      findMaxes :: m (Natural, Natural) -> PathData -> m (Natural, Natural)
findMaxes m (Natural, Natural)
acc PathData
pd = do
        (!Natural
maxNameSoFar, !Natural
maxOrigSoFar) <- m (Natural, Natural)
acc
        Natural
nameLen <- PathI 'TrashEntryFileName -> m Natural
forall (i :: PathIndex). PathI i -> m Natural
pathLen (PathI 'TrashEntryFileName -> m Natural)
-> PathI 'TrashEntryFileName -> m Natural
forall a b. (a -> b) -> a -> b
$ PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName
        Natural
origLen <- PathI 'TrashEntryOriginalPath -> m Natural
forall (i :: PathIndex). PathI i -> m Natural
pathLen (PathI 'TrashEntryOriginalPath -> m Natural)
-> PathI 'TrashEntryOriginalPath -> m Natural
forall a b. (a -> b) -> a -> b
$ PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
-> PathI 'TrashEntryOriginalPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
#originalPath
        (Natural, Natural) -> m (Natural, Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max Natural
maxNameSoFar Natural
nameLen, Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max Natural
maxOrigSoFar Natural
origLen)

      maxStart :: (Natural, Natural)
      maxStart :: (Natural, Natural)
maxStart = (Natural
Formatting.formatFileNameLenMin, Natural
Formatting.formatOriginalPathLenMin)

      pathLen :: PathI i -> m Natural
      pathLen :: forall (i :: PathIndex). PathI i -> m Natural
pathLen (MkPathI OsPath
p) = do
        String
p' <- OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM OsPath
p
        Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> m Natural) -> Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p'

      -- Map the format to its strategy
      fmtToStrategy :: Natural -> Maybe ColFormat -> Maybe Natural
      fmtToStrategy :: Natural -> Maybe ColFormat -> Maybe Natural
fmtToStrategy Natural
maxLen Maybe ColFormat
mcolFormat = Maybe Natural
wantsFixed Maybe Natural -> Maybe Natural -> Maybe Natural
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Natural
wantsMax
        where
          wantsFixed :: Maybe Natural
wantsFixed = Optic' A_Prism NoIx (Maybe ColFormat) Natural
-> Maybe ColFormat -> Maybe Natural
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Prism (Maybe ColFormat) (Maybe ColFormat) ColFormat ColFormat
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Prism (Maybe ColFormat) (Maybe ColFormat) ColFormat ColFormat
-> Optic A_Prism NoIx ColFormat ColFormat Natural Natural
-> Optic' A_Prism NoIx (Maybe ColFormat) Natural
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx ColFormat ColFormat Natural Natural
_ColFormatFixed) Maybe ColFormat
mcolFormat
          wantsMax :: Maybe Natural
wantsMax = Optic' A_Prism NoIx (Maybe ColFormat) ()
-> Maybe ColFormat -> Maybe ()
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Prism (Maybe ColFormat) (Maybe ColFormat) ColFormat ColFormat
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Prism (Maybe ColFormat) (Maybe ColFormat) ColFormat ColFormat
-> Optic A_Prism NoIx ColFormat ColFormat () ()
-> Optic' A_Prism NoIx (Maybe ColFormat) ()
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx ColFormat ColFormat () ()
_ColFormatMax) Maybe ColFormat
mcolFormat Maybe () -> Natural -> Maybe Natural
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Natural
maxLen

      revSort :: Bool
revSort = ListCmdP2
listCmd ListCmdP2 -> Optic' A_Lens NoIx ListCmdP2 Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListCmdP2 Bool
#revSort
      sort :: Sort
sort = ListCmdP2
listCmd ListCmdP2 -> Optic' A_Lens NoIx ListCmdP2 Sort -> Sort
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListCmdP2 Sort
#sort

-- | Derives the column lengths for our one dynamic column @C@ when given
-- exactly one fixed column length (@D_len@).
--
-- Given @mkDynamicLen T_max C_min C_max D_len@, we return @C_len@ based on
-- the following logic:
--
-- 1. If @D_len + C_max <= T_max@:
--        Return @C_max@.
-- 2. Else if @D_len < T_max@:
--        Return @(max (T_max - D_len) C_min)@.
--        That is, use @D_len@ as requested and give all remaining space to @C@
--        (falling back to @C_min@ if required).
-- 3. Otherwise:
--        Return @C_min@. We are going to wrap regardless since @D_len > T_max@,
--        so just ust it and @C_min@.
mkDynamicLen ::
  (MonadLoggerNS f) =>
  -- | @T_max@: Max total len for our dynamic columns
  Natural ->
  -- | @C_min@: Min required len for our derived column
  Natural ->
  -- | @C_max@: Max len for the column (i.e. the smallest @l@ s.t. all entries fit
  -- in this length)
  Natural ->
  -- | @D_len@: The fixed, requested length for the other column.
  Natural ->
  -- | Derived @C_len@
  f Natural
mkDynamicLen :: forall (f :: * -> *).
MonadLoggerNS f =>
Natural -> Natural -> Natural -> Natural -> f Natural
mkDynamicLen Natural
tMax Natural
cMin Natural
cMax Natural
dLen =
  Text -> f Natural -> f Natural
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"mkDynamicLen"
    (f Natural -> f Natural) -> f Natural -> f Natural
forall a b. (a -> b) -> a -> b
$ if Natural
dLen Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
cMax Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
tMax
      then -- 1. dLen and cMax fit; use cMax
        Natural -> f Natural
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
cMax
      else do
        -- 2. dLen + cMax will not fit, but at least dLen < tMax; use all
        -- remaining space to print as much as we can. As we require at least
        -- minimums, this could lead to wrapping.
        if Natural
dLen Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
tMax
          then do
            $(logDebug)
              (Text -> f ()) -> Text -> f ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"Maximum len (",
                  Natural -> Text
forall a. Show a => a -> Text
showt Natural
cMax,
                  Text
") does not fit with requested other length (",
                  Natural -> Text
forall a. Show a => a -> Text
showt Natural
dLen,
                  Text
") and calculated terminal space (",
                  Natural -> Text
forall a. Show a => a -> Text
showt Natural
tMax,
                  Text
")"
                ]
            Natural -> f Natural
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max (Natural
tMax Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
dLen) Natural
cMin)
          else -- 3. Requested dLen > tMax. We are going to wrap regardless,
          -- so use cMin.
          do
            $(logWarn)
              (Text -> f ()) -> Text -> f ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"Requested other length (",
                  Natural -> Text
forall a. Show a => a -> Text
showt Natural
dLen,
                  Text
") > calculated terminal space (",
                  Natural -> Text
forall a. Show a => a -> Text
showt Natural
tMax,
                  Text
"). Falling back to minimum len: ",
                  Natural -> Text
forall a. Show a => a -> Text
showt Natural
cMin
                ]
            Natural -> f Natural
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
cMin

getTerminalLen :: (MonadCatch m, MonadLoggerNS m, MonadTerminal m) => m Natural
getTerminalLen :: forall (m :: * -> *).
(MonadCatch m, MonadLoggerNS m, MonadTerminal m) =>
m Natural
getTerminalLen = Text -> m Natural -> m Natural
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"getTerminalLen" (m Natural -> m Natural) -> m Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ do
  m Natural -> m (Either SomeException Natural)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny m Natural
forall (m :: * -> *). (HasCallStack, MonadTerminal m) => m Natural
getTerminalWidth m (Either SomeException Natural)
-> (Either SomeException Natural -> m Natural) -> m Natural
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Natural
w -> Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
w
    Left SomeException
err -> do
      $(logWarn)
        (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not detect terminal length. Falling back to default 80. Error:\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
displayExceptiont SomeException
err
      Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
80

multiline :: (PathDataCore -> PathDataCore -> Ordering) -> Seq PathDataCore -> Text
multiline :: (PathData -> PathData -> Ordering) -> Seq PathData -> Text
multiline PathData -> PathData -> Ordering
sort =
  Text -> [Text] -> Text
T.intercalate Text
"\n\n"
    ([Text] -> Text)
-> (Seq PathData -> [Text]) -> Seq PathData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathData -> Text) -> [PathData] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathData -> Text
Formatting.formatMultiline
    ([PathData] -> [Text])
-> (Seq PathData -> [PathData]) -> Seq PathData -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq PathData -> [PathData]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (Seq PathData -> [PathData])
-> (Seq PathData -> Seq PathData) -> Seq PathData -> [PathData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathData -> PathData -> Ordering) -> Seq PathData -> Seq PathData
getElems PathData -> PathData -> Ordering
sort

singleline :: Bool -> Seq PathDataCore -> Text
singleline :: Bool -> Seq PathData -> Text
singleline Bool
coloring =
  Text -> [Text] -> Text
T.intercalate Text
"\n"
    ([Text] -> Text)
-> (Seq PathData -> [Text]) -> Seq PathData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Color, PathData) -> [Text] -> [Text])
-> [Text] -> [(Color, PathData)] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Color, PathData) -> [Text] -> [Text]
f []
    ([(Color, PathData)] -> [Text])
-> (Seq PathData -> [(Color, PathData)]) -> Seq PathData -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Color] -> [PathData] -> [(Color, PathData)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [Color]
colorStream
    ([PathData] -> [(Color, PathData)])
-> (Seq PathData -> [PathData])
-> Seq PathData
-> [(Color, PathData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq PathData -> [PathData]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (Seq PathData -> [PathData])
-> (Seq PathData -> Seq PathData) -> Seq PathData -> [PathData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathData -> PathI 'TrashEntryOriginalPath)
-> Seq PathData -> Seq PathData
forall b a. Ord b => (a -> b) -> Seq a -> Seq a
Seq.sortOn (Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
-> PathData -> PathI 'TrashEntryOriginalPath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PathData (PathI 'TrashEntryOriginalPath)
#originalPath)
  where
    f :: (Color, PathData) -> [Text] -> [Text]
    f :: (Color, PathData) -> [Text] -> [Text]
f (Color
c, PathData
pd) [Text]
acc = Color -> PathData -> Text
colorFn Color
c PathData
pd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc

    colorFn :: Color -> PathData -> Text
colorFn
      | Bool
coloring = Color -> PathData -> Text
Formatting.formatSinglelineColor
      | Bool
otherwise = (PathData -> Text) -> Color -> PathData -> Text
forall a b. a -> b -> a
const PathData -> Text
Formatting.formatSingleline

colorStream :: [Color]
colorStream :: [Color]
colorStream = Color
Blue Color -> [Color] -> [Color]
forall a. a -> [a] -> [a]
: Color
Magenta Color -> [Color] -> [Color]
forall a. a -> [a] -> [a]
: [Color]
colorStream

tabular ::
  Bool ->
  (PathDataCore -> PathDataCore -> Ordering) ->
  Natural ->
  Natural ->
  Seq PathDataCore ->
  Text
tabular :: Bool
-> (PathData -> PathData -> Ordering)
-> Natural
-> Natural
-> Seq PathData
-> Text
tabular Bool
coloring PathData -> PathData -> Ordering
sort Natural
nameLen Natural
origLen =
  ((Color -> Natural -> Natural -> Text
headerFn Color
headerColor Natural
nameLen Natural
origLen Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") <>)
    (Text -> Text) -> (Seq PathData -> Text) -> Seq PathData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
    ([Text] -> Text)
-> (Seq PathData -> [Text]) -> Seq PathData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Color, PathData) -> [Text] -> [Text])
-> [Text] -> [(Color, PathData)] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Color, PathData) -> [Text] -> [Text]
f []
    ([(Color, PathData)] -> [Text])
-> (Seq PathData -> [(Color, PathData)]) -> Seq PathData -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Color] -> [PathData] -> [(Color, PathData)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [Color]
colorStream
    ([PathData] -> [(Color, PathData)])
-> (Seq PathData -> [PathData])
-> Seq PathData
-> [(Color, PathData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq PathData -> [PathData]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (Seq PathData -> [PathData])
-> (Seq PathData -> Seq PathData) -> Seq PathData -> [PathData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathData -> PathData -> Ordering) -> Seq PathData -> Seq PathData
getElems PathData -> PathData -> Ordering
sort
  where
    headerColor :: Color
headerColor = Color
Green

    f :: (Color, PathData) -> [Text] -> [Text]
    f :: (Color, PathData) -> [Text] -> [Text]
f (Color
c, PathData
pd) [Text]
acc = Color -> Natural -> Natural -> PathData -> Text
rowFn Color
c Natural
nameLen Natural
origLen PathData
pd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc

    (Color -> Natural -> Natural -> Text
headerFn, Color -> Natural -> Natural -> PathData -> Text
rowFn)
      | Bool
coloring = (Color -> Natural -> Natural -> Text
Formatting.formatTabularHeaderColor, Color -> Natural -> Natural -> PathData -> Text
Formatting.formatTabularRowColor)
      | Bool
otherwise = ((Natural -> Natural -> Text) -> Color -> Natural -> Natural -> Text
forall a b. a -> b -> a
const Natural -> Natural -> Text
Formatting.formatTabularHeader, (Natural -> Natural -> PathData -> Text)
-> Color -> Natural -> Natural -> PathData -> Text
forall a b. a -> b -> a
const Natural -> Natural -> PathData -> Text
Formatting.formatTabularRow)

getElems ::
  (PathDataCore -> PathDataCore -> Ordering) ->
  Seq PathDataCore ->
  Seq PathDataCore
getElems :: (PathData -> PathData -> Ordering) -> Seq PathData -> Seq PathData
getElems = (PathData -> PathData -> Ordering) -> Seq PathData -> Seq PathData
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy

fromList :: [PathData] -> HashMap (PathI TrashEntryFileName) PathData
fromList :: [PathData] -> HashMap (PathI 'TrashEntryFileName) PathData
fromList = (PathData
 -> HashMap (PathI 'TrashEntryFileName) PathData
 -> HashMap (PathI 'TrashEntryFileName) PathData)
-> HashMap (PathI 'TrashEntryFileName) PathData
-> [PathData]
-> HashMap (PathI 'TrashEntryFileName) PathData
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PathData
-> HashMap (PathI 'TrashEntryFileName) PathData
-> HashMap (PathI 'TrashEntryFileName) PathData
insert HashMap (PathI 'TrashEntryFileName) PathData
forall k v. HashMap k v
HMap.empty

insert ::
  PathData ->
  HashMap (PathI TrashEntryFileName) PathData ->
  HashMap (PathI TrashEntryFileName) PathData
insert :: PathData
-> HashMap (PathI 'TrashEntryFileName) PathData
-> HashMap (PathI 'TrashEntryFileName) PathData
insert PathData
pd = PathI 'TrashEntryFileName
-> PathData
-> HashMap (PathI 'TrashEntryFileName) PathData
-> HashMap (PathI 'TrashEntryFileName) PathData
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMap.insert (PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName) PathData
pd

getColoring :: (HasCallStack, MonadTerminal m) => Coloring -> m Bool
getColoring :: forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Coloring -> m Bool
getColoring Coloring
ColoringDetect = m Bool
forall (m :: * -> *). (MonadTerminal m, HasCallStack) => m Bool
Term.supportsPretty
getColoring Coloring
ColoringOff = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
getColoring Coloring
ColoringOn = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True