{-# LANGUAGE UndecidableInstances #-}

module Shrun.Configuration.Data.Truncation
  ( TruncRegion (..),
    Truncation (..),
    parseTruncation,
    LineTruncation (..),
    parseLineTruncation,

    -- * Misc
    decodeCommandNameTrunc,
    decodeLineTrunc,
    configToLineTrunc,
  )
where

import Effects.System.Terminal (getTerminalWidth)
import Shrun.Configuration.Data.WithDisabled
  ( WithDisabled
      ( Disabled,
        With,
        Without
      ),
  )
import Shrun.Prelude

-- | The different regions to apply truncation rules.
data TruncRegion
  = -- | Apply truncation rules to commands/key names.
    TruncCommandName
  | -- | Apply truncation rules to command log entire lines.
    TruncLine
  deriving stock (TruncRegion -> TruncRegion -> Bool
(TruncRegion -> TruncRegion -> Bool)
-> (TruncRegion -> TruncRegion -> Bool) -> Eq TruncRegion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TruncRegion -> TruncRegion -> Bool
== :: TruncRegion -> TruncRegion -> Bool
$c/= :: TruncRegion -> TruncRegion -> Bool
/= :: TruncRegion -> TruncRegion -> Bool
Eq, Int -> TruncRegion -> ShowS
[TruncRegion] -> ShowS
TruncRegion -> String
(Int -> TruncRegion -> ShowS)
-> (TruncRegion -> String)
-> ([TruncRegion] -> ShowS)
-> Show TruncRegion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TruncRegion -> ShowS
showsPrec :: Int -> TruncRegion -> ShowS
$cshow :: TruncRegion -> String
show :: TruncRegion -> String
$cshowList :: [TruncRegion] -> ShowS
showList :: [TruncRegion] -> ShowS
Show)

-- | The maximum number of command characters to display in the logs.
type Truncation :: TruncRegion -> Type
newtype Truncation a = MkTruncation
  { forall (a :: TruncRegion). Truncation a -> Natural
unTruncation :: Natural
  }
  deriving stock (Truncation a -> Truncation a -> Bool
(Truncation a -> Truncation a -> Bool)
-> (Truncation a -> Truncation a -> Bool) -> Eq (Truncation a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
$c== :: forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
== :: Truncation a -> Truncation a -> Bool
$c/= :: forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
/= :: Truncation a -> Truncation a -> Bool
Eq, Eq (Truncation a)
Eq (Truncation a) =>
(Truncation a -> Truncation a -> Ordering)
-> (Truncation a -> Truncation a -> Bool)
-> (Truncation a -> Truncation a -> Bool)
-> (Truncation a -> Truncation a -> Bool)
-> (Truncation a -> Truncation a -> Bool)
-> (Truncation a -> Truncation a -> Truncation a)
-> (Truncation a -> Truncation a -> Truncation a)
-> Ord (Truncation a)
Truncation a -> Truncation a -> Bool
Truncation a -> Truncation a -> Ordering
Truncation a -> Truncation a -> Truncation a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: TruncRegion). Eq (Truncation a)
forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
forall (a :: TruncRegion). Truncation a -> Truncation a -> Ordering
forall (a :: TruncRegion).
Truncation a -> Truncation a -> Truncation a
$ccompare :: forall (a :: TruncRegion). Truncation a -> Truncation a -> Ordering
compare :: Truncation a -> Truncation a -> Ordering
$c< :: forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
< :: Truncation a -> Truncation a -> Bool
$c<= :: forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
<= :: Truncation a -> Truncation a -> Bool
$c> :: forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
> :: Truncation a -> Truncation a -> Bool
$c>= :: forall (a :: TruncRegion). Truncation a -> Truncation a -> Bool
>= :: Truncation a -> Truncation a -> Bool
$cmax :: forall (a :: TruncRegion).
Truncation a -> Truncation a -> Truncation a
max :: Truncation a -> Truncation a -> Truncation a
$cmin :: forall (a :: TruncRegion).
Truncation a -> Truncation a -> Truncation a
min :: Truncation a -> Truncation a -> Truncation a
Ord, Int -> Truncation a -> ShowS
[Truncation a] -> ShowS
Truncation a -> String
(Int -> Truncation a -> ShowS)
-> (Truncation a -> String)
-> ([Truncation a] -> ShowS)
-> Show (Truncation a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: TruncRegion). Int -> Truncation a -> ShowS
forall (a :: TruncRegion). [Truncation a] -> ShowS
forall (a :: TruncRegion). Truncation a -> String
$cshowsPrec :: forall (a :: TruncRegion). Int -> Truncation a -> ShowS
showsPrec :: Int -> Truncation a -> ShowS
$cshow :: forall (a :: TruncRegion). Truncation a -> String
show :: Truncation a -> String
$cshowList :: forall (a :: TruncRegion). [Truncation a] -> ShowS
showList :: [Truncation a] -> ShowS
Show)
  deriving (Integer -> Truncation a
Truncation a -> Truncation a
Truncation a -> Truncation a -> Truncation a
(Truncation a -> Truncation a -> Truncation a)
-> (Truncation a -> Truncation a -> Truncation a)
-> (Truncation a -> Truncation a -> Truncation a)
-> (Truncation a -> Truncation a)
-> (Truncation a -> Truncation a)
-> (Truncation a -> Truncation a)
-> (Integer -> Truncation a)
-> Num (Truncation a)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (a :: TruncRegion). Integer -> Truncation a
forall (a :: TruncRegion). Truncation a -> Truncation a
forall (a :: TruncRegion).
Truncation a -> Truncation a -> Truncation a
$c+ :: forall (a :: TruncRegion).
Truncation a -> Truncation a -> Truncation a
+ :: Truncation a -> Truncation a -> Truncation a
$c- :: forall (a :: TruncRegion).
Truncation a -> Truncation a -> Truncation a
- :: Truncation a -> Truncation a -> Truncation a
$c* :: forall (a :: TruncRegion).
Truncation a -> Truncation a -> Truncation a
* :: Truncation a -> Truncation a -> Truncation a
$cnegate :: forall (a :: TruncRegion). Truncation a -> Truncation a
negate :: Truncation a -> Truncation a
$cabs :: forall (a :: TruncRegion). Truncation a -> Truncation a
abs :: Truncation a -> Truncation a
$csignum :: forall (a :: TruncRegion). Truncation a -> Truncation a
signum :: Truncation a -> Truncation a
$cfromInteger :: forall (a :: TruncRegion). Integer -> Truncation a
fromInteger :: Integer -> Truncation a
Num) via Natural

instance
  (k ~ An_Iso, a ~ Natural, b ~ Natural) =>
  LabelOptic "unTruncation" k (Truncation r) (Truncation r) a b
  where
  labelOptic :: Optic k NoIx (Truncation r) (Truncation r) a b
labelOptic = (Truncation r -> a)
-> (b -> Truncation r) -> Iso (Truncation r) (Truncation r) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(MkTruncation Natural
x) -> a
Natural
x) b -> Truncation r
Natural -> Truncation r
forall (a :: TruncRegion). Natural -> Truncation a
MkTruncation
  {-# INLINE labelOptic #-}

instance DecodeTOML (Truncation a) where
  tomlDecoder :: Decoder (Truncation a)
tomlDecoder = Decoder Natural -> Decoder (Truncation a)
forall (m :: Type -> Type) (r :: TruncRegion).
MonadFail m =>
m Natural -> m (Truncation r)
parseTruncation Decoder Natural
forall a. DecodeTOML a => Decoder a
tomlDecoder

parseTruncation :: (MonadFail m) => m Natural -> m (Truncation r)
parseTruncation :: forall (m :: Type -> Type) (r :: TruncRegion).
MonadFail m =>
m Natural -> m (Truncation r)
parseTruncation m Natural
getNat = Natural -> Truncation r
forall (a :: TruncRegion). Natural -> Truncation a
MkTruncation (Natural -> Truncation r) -> m Natural -> m (Truncation r)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m Natural
getNat

-- | Determines command log line truncation behavior. We need a separate
-- type from 'Truncation' to add a third option, to detect the terminal size
-- automatically.
data LineTruncation
  = Undetected (Truncation TruncLine)
  | Detected
  deriving stock (LineTruncation -> LineTruncation -> Bool
(LineTruncation -> LineTruncation -> Bool)
-> (LineTruncation -> LineTruncation -> Bool) -> Eq LineTruncation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineTruncation -> LineTruncation -> Bool
== :: LineTruncation -> LineTruncation -> Bool
$c/= :: LineTruncation -> LineTruncation -> Bool
/= :: LineTruncation -> LineTruncation -> Bool
Eq, Int -> LineTruncation -> ShowS
[LineTruncation] -> ShowS
LineTruncation -> String
(Int -> LineTruncation -> ShowS)
-> (LineTruncation -> String)
-> ([LineTruncation] -> ShowS)
-> Show LineTruncation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineTruncation -> ShowS
showsPrec :: Int -> LineTruncation -> ShowS
$cshow :: LineTruncation -> String
show :: LineTruncation -> String
$cshowList :: [LineTruncation] -> ShowS
showList :: [LineTruncation] -> ShowS
Show)

instance DecodeTOML LineTruncation where
  tomlDecoder :: Decoder LineTruncation
tomlDecoder = Decoder Natural -> Decoder Text -> Decoder LineTruncation
forall (m :: Type -> Type).
(Alternative m, MonadFail m) =>
m Natural -> m Text -> m LineTruncation
parseLineTruncation Decoder Natural
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder

parseLineTruncation ::
  (Alternative m, MonadFail m) =>
  m Natural ->
  m Text ->
  m LineTruncation
parseLineTruncation :: forall (m :: Type -> Type).
(Alternative m, MonadFail m) =>
m Natural -> m Text -> m LineTruncation
parseLineTruncation m Natural
getNat m Text
getTxt =
  Truncation 'TruncLine -> LineTruncation
Undetected
    (Truncation 'TruncLine -> LineTruncation)
-> m (Truncation 'TruncLine) -> m LineTruncation
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m Natural -> m (Truncation 'TruncLine)
forall (m :: Type -> Type) (r :: TruncRegion).
MonadFail m =>
m Natural -> m (Truncation r)
parseTruncation m Natural
getNat
    m LineTruncation -> m LineTruncation -> m LineTruncation
forall a. m a -> m a -> m a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> m Text -> m LineTruncation
forall (m :: Type -> Type).
MonadFail m =>
m Text -> m LineTruncation
parseDetected m Text
getTxt

parseDetected :: (MonadFail m) => m Text -> m LineTruncation
parseDetected :: forall (m :: Type -> Type).
MonadFail m =>
m Text -> m LineTruncation
parseDetected m Text
getTxt =
  m Text
getTxt m Text -> (Text -> m LineTruncation) -> m LineTruncation
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"detect" -> LineTruncation -> m LineTruncation
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure LineTruncation
Detected
    Text
other -> String -> m LineTruncation
forall a. String -> m a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> m LineTruncation) -> String -> m LineTruncation
forall a b. (a -> b) -> a -> b
$ String
"Wanted other, received: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
other

decodeCommandNameTrunc :: Decoder (Maybe (Truncation TruncCommandName))
decodeCommandNameTrunc :: Decoder (Maybe (Truncation 'TruncCommandName))
decodeCommandNameTrunc = Decoder (Truncation 'TruncCommandName)
-> Text -> Decoder (Maybe (Truncation 'TruncCommandName))
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder (Truncation 'TruncCommandName)
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"command-name-trunc"

decodeLineTrunc :: Decoder (Maybe LineTruncation)
decodeLineTrunc :: Decoder (Maybe LineTruncation)
decodeLineTrunc = Decoder LineTruncation -> Text -> Decoder (Maybe LineTruncation)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder LineTruncation
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"line-trunc"

-- | Maps line trunc config to actual value.
configToLineTrunc ::
  ( HasCallStack,
    MonadTerminal m
  ) =>
  WithDisabled LineTruncation ->
  m (Maybe (Truncation TruncLine))
configToLineTrunc :: forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
WithDisabled LineTruncation -> m (Maybe (Truncation 'TruncLine))
configToLineTrunc WithDisabled LineTruncation
Disabled = Maybe (Truncation 'TruncLine) -> m (Maybe (Truncation 'TruncLine))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Truncation 'TruncLine)
forall a. Maybe a
Nothing
configToLineTrunc WithDisabled LineTruncation
Without = Maybe (Truncation 'TruncLine) -> m (Maybe (Truncation 'TruncLine))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Truncation 'TruncLine)
forall a. Maybe a
Nothing
configToLineTrunc (With LineTruncation
Detected) = Truncation 'TruncLine -> Maybe (Truncation 'TruncLine)
forall a. a -> Maybe a
Just (Truncation 'TruncLine -> Maybe (Truncation 'TruncLine))
-> (Natural -> Truncation 'TruncLine)
-> Natural
-> Maybe (Truncation 'TruncLine)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Truncation 'TruncLine
forall (a :: TruncRegion). Natural -> Truncation a
MkTruncation (Natural -> Maybe (Truncation 'TruncLine))
-> m Natural -> m (Maybe (Truncation 'TruncLine))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m Natural
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
m Natural
getTerminalWidth
configToLineTrunc (With (Undetected Truncation 'TruncLine
x)) = Maybe (Truncation 'TruncLine) -> m (Maybe (Truncation 'TruncLine))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (Truncation 'TruncLine)
 -> m (Maybe (Truncation 'TruncLine)))
-> Maybe (Truncation 'TruncLine)
-> m (Maybe (Truncation 'TruncLine))
forall a b. (a -> b) -> a -> b
$ Truncation 'TruncLine -> Maybe (Truncation 'TruncLine)
forall a. a -> Maybe a
Just Truncation 'TruncLine
x