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

-- | Provides functionality for the list command
module Charon.Runner.Command.List
  ( -- * Phase 1
    ListFormatStyle (..),
    parseListFormat,
    ListFormatPhase1 (..),

    -- * Phase 2
    ListCmd (..),
    ListCmdP1,
    ListCmdP2,
  )
where

import Charon.Data.PathData.Formatting
  ( ColFormat,
    Coloring (ColoringDetect),
    PathDataFormat (FormatMultiline, FormatSingleline, FormatTabular),
    Sort (Name),
  )
import Charon.Prelude
import Charon.Runner.Phase
  ( AdvancePhase (NextPhase, advancePhase),
    MaybePhaseF,
    Phase (Phase1, Phase2),
  )
import Data.Text qualified as T

--------------------------------------------------------------------------------
----------------------------------- PHASE 1 ------------------------------------
--------------------------------------------------------------------------------

-- | Configuration option for the list command format.
data ListFormatStyle
  = ListFormatStyleMultiline
  | ListFormatStyleTabular
  | ListFormatStyleSingleline
  deriving stock (ListFormatStyle -> ListFormatStyle -> Bool
(ListFormatStyle -> ListFormatStyle -> Bool)
-> (ListFormatStyle -> ListFormatStyle -> Bool)
-> Eq ListFormatStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListFormatStyle -> ListFormatStyle -> Bool
== :: ListFormatStyle -> ListFormatStyle -> Bool
$c/= :: ListFormatStyle -> ListFormatStyle -> Bool
/= :: ListFormatStyle -> ListFormatStyle -> Bool
Eq, Int -> ListFormatStyle -> ShowS
[ListFormatStyle] -> ShowS
ListFormatStyle -> String
(Int -> ListFormatStyle -> ShowS)
-> (ListFormatStyle -> String)
-> ([ListFormatStyle] -> ShowS)
-> Show ListFormatStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListFormatStyle -> ShowS
showsPrec :: Int -> ListFormatStyle -> ShowS
$cshow :: ListFormatStyle -> String
show :: ListFormatStyle -> String
$cshowList :: [ListFormatStyle] -> ShowS
showList :: [ListFormatStyle] -> ShowS
Show)

parseListFormat :: (MonadFail m) => Text -> m ListFormatStyle
parseListFormat :: forall (m :: * -> *). MonadFail m => Text -> m ListFormatStyle
parseListFormat Text
"multi" = ListFormatStyle -> m ListFormatStyle
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListFormatStyle
ListFormatStyleMultiline
parseListFormat Text
"m" = ListFormatStyle -> m ListFormatStyle
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListFormatStyle
ListFormatStyleMultiline
parseListFormat Text
"tabular" = ListFormatStyle -> m ListFormatStyle
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListFormatStyle
ListFormatStyleTabular
parseListFormat Text
"t" = ListFormatStyle -> m ListFormatStyle
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListFormatStyle
ListFormatStyleTabular
parseListFormat Text
"single" = ListFormatStyle -> m ListFormatStyle
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListFormatStyle
ListFormatStyleSingleline
parseListFormat Text
"s" = ListFormatStyle -> m ListFormatStyle
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListFormatStyle
ListFormatStyleSingleline
parseListFormat Text
other = String -> m ListFormatStyle
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ListFormatStyle) -> String -> m ListFormatStyle
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
other

-- | Holds all configuration data for list formatting i.e. style and
-- truncation params.
data ListFormatPhase1 = MkListFormatPhase1
  { ListFormatPhase1 -> Maybe Coloring
coloring :: Maybe Coloring,
    -- | Format style.
    ListFormatPhase1 -> Maybe ListFormatStyle
style :: Maybe ListFormatStyle,
    -- | Name truncation.
    ListFormatPhase1 -> Maybe ColFormat
nameTrunc :: Maybe ColFormat,
    -- | Original path truncation.
    ListFormatPhase1 -> Maybe ColFormat
origTrunc :: Maybe ColFormat
  }
  deriving stock (ListFormatPhase1 -> ListFormatPhase1 -> Bool
(ListFormatPhase1 -> ListFormatPhase1 -> Bool)
-> (ListFormatPhase1 -> ListFormatPhase1 -> Bool)
-> Eq ListFormatPhase1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListFormatPhase1 -> ListFormatPhase1 -> Bool
== :: ListFormatPhase1 -> ListFormatPhase1 -> Bool
$c/= :: ListFormatPhase1 -> ListFormatPhase1 -> Bool
/= :: ListFormatPhase1 -> ListFormatPhase1 -> Bool
Eq, Int -> ListFormatPhase1 -> ShowS
[ListFormatPhase1] -> ShowS
ListFormatPhase1 -> String
(Int -> ListFormatPhase1 -> ShowS)
-> (ListFormatPhase1 -> String)
-> ([ListFormatPhase1] -> ShowS)
-> Show ListFormatPhase1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListFormatPhase1 -> ShowS
showsPrec :: Int -> ListFormatPhase1 -> ShowS
$cshow :: ListFormatPhase1 -> String
show :: ListFormatPhase1 -> String
$cshowList :: [ListFormatPhase1] -> ShowS
showList :: [ListFormatPhase1] -> ShowS
Show)

makeFieldLabelsNoPrefix ''ListFormatPhase1

--------------------------------------------------------------------------------
----------------------------------- PHASE 2 ------------------------------------
--------------------------------------------------------------------------------

-- | Associates the phase to the formatting type.
type ListFormatPhaseF :: Phase -> Type
type family ListFormatPhaseF s where
  ListFormatPhaseF Phase1 = ListFormatPhase1
  ListFormatPhaseF Phase2 = PathDataFormat

instance AdvancePhase ListFormatPhase1 where
  type NextPhase ListFormatPhase1 = PathDataFormat

  advancePhase :: ListFormatPhase1 -> NextPhase ListFormatPhase1
advancePhase ListFormatPhase1
formatPhase1 = case ListFormatPhase1
formatPhase1 ListFormatPhase1
-> Optic' A_Lens NoIx ListFormatPhase1 (Maybe ListFormatStyle)
-> Maybe ListFormatStyle
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListFormatPhase1 (Maybe ListFormatStyle)
#style of
    Just ListFormatStyle
ListFormatStyleMultiline -> NextPhase ListFormatPhase1
PathDataFormat
FormatMultiline
    Just ListFormatStyle
ListFormatStyleSingleline -> Coloring -> PathDataFormat
FormatSingleline Coloring
coloring
    Just ListFormatStyle
ListFormatStyleTabular ->
      Coloring -> Maybe ColFormat -> Maybe ColFormat -> PathDataFormat
FormatTabular
        Coloring
coloring
        (ListFormatPhase1
formatPhase1 ListFormatPhase1
-> Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
-> Maybe ColFormat
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
#nameTrunc)
        (ListFormatPhase1
formatPhase1 ListFormatPhase1
-> Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
-> Maybe ColFormat
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
#origTrunc)
    Maybe ListFormatStyle
Nothing ->
      Coloring -> Maybe ColFormat -> Maybe ColFormat -> PathDataFormat
FormatTabular
        Coloring
coloring
        (ListFormatPhase1
formatPhase1 ListFormatPhase1
-> Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
-> Maybe ColFormat
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
#nameTrunc)
        (ListFormatPhase1
formatPhase1 ListFormatPhase1
-> Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
-> Maybe ColFormat
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListFormatPhase1 (Maybe ColFormat)
#origTrunc)
    where
      coloring :: Coloring
coloring = Coloring -> Maybe Coloring -> Coloring
forall a. a -> Maybe a -> a
fromMaybe Coloring
ColoringDetect (ListFormatPhase1
formatPhase1 ListFormatPhase1
-> Optic' A_Lens NoIx ListFormatPhase1 (Maybe Coloring)
-> Maybe Coloring
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ListFormatPhase1 (Maybe Coloring)
#coloring)

-- | Arguments for the list command.
type ListCmd :: Phase -> Type
data ListCmd p = MkListCmd
  { -- | Format style.
    forall (p :: Phase). ListCmd p -> ListFormatPhaseF p
format :: ListFormatPhaseF p,
    -- | How to sort the list.
    forall (p :: Phase). ListCmd p -> MaybePhaseF p Sort
sort :: MaybePhaseF p Sort,
    -- | Whether to reverse the sort.
    forall (p :: Phase). ListCmd p -> MaybePhaseF p Bool
revSort :: MaybePhaseF p Bool
  }

makeFieldLabelsNoPrefix ''ListCmd

deriving stock instance Eq (ListCmd Phase1)

deriving stock instance Show (ListCmd Phase1)

deriving stock instance Eq (ListCmd Phase2)

deriving stock instance Show (ListCmd Phase2)

type ListCmdP1 = ListCmd Phase1

type ListCmdP2 = ListCmd Phase2

instance AdvancePhase (ListCmd Phase1) where
  type NextPhase (ListCmd Phase1) = ListCmd Phase2

  advancePhase :: ListCmd 'Phase1 -> NextPhase (ListCmd 'Phase1)
advancePhase ListCmd 'Phase1
listCfg =
    MkListCmd
      { NextPhase ListFormatPhase1
ListFormatPhaseF 'Phase2
$sel:format:MkListCmd :: ListFormatPhaseF 'Phase2
format :: NextPhase ListFormatPhase1
format,
        MaybePhaseF 'Phase2 Sort
Sort
$sel:sort:MkListCmd :: MaybePhaseF 'Phase2 Sort
sort :: Sort
sort,
        Bool
MaybePhaseF 'Phase2 Bool
$sel:revSort:MkListCmd :: MaybePhaseF 'Phase2 Bool
revSort :: Bool
revSort
      }
    where
      sort :: Sort
sort = Sort -> Maybe Sort -> Sort
forall a. a -> Maybe a -> a
fromMaybe Sort
Name (ListCmd 'Phase1
listCfg ListCmd 'Phase1
-> Optic' A_Lens NoIx (ListCmd 'Phase1) (Maybe Sort) -> Maybe Sort
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (ListCmd 'Phase1) (Maybe Sort)
#sort)
      revSort :: Bool
revSort = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (ListCmd 'Phase1
listCfg ListCmd 'Phase1
-> Optic' A_Lens NoIx (ListCmd 'Phase1) (Maybe Bool) -> Maybe Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (ListCmd 'Phase1) (Maybe Bool)
#revSort)
      format :: NextPhase ListFormatPhase1
format = ListFormatPhase1 -> NextPhase ListFormatPhase1
forall a. AdvancePhase a => a -> NextPhase a
advancePhase (ListCmd 'Phase1
listCfg ListCmd 'Phase1
-> Optic' A_Lens NoIx (ListCmd 'Phase1) ListFormatPhase1
-> ListFormatPhase1
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (ListCmd 'Phase1) ListFormatPhase1
#format)