content: module Cabal.Matrix.Tui.Flavor
    ( FlavorState
    , initFlavorState
    , flavorFromRecording
    , TimerEvent(..)
    , flavorHandleTimerEvent
    , flavorHandleSchedulerEvent
    , OutputState(..)
    , initOutputState
    , outputWidget
    , outputHandleEvent
    , outputKeybinds
    , matrixCellWidth
    , matrixCellHeight
    , cellWidget
    ) where
  
  import Cabal.Matrix.CabalArgs
  import Cabal.Matrix.ProcessRunner
  import Cabal.Matrix.Record
  import Cabal.Matrix.Scheduler
  import Cabal.Matrix.Tui.Common
  import Data.Bifunctor
  import Data.ByteString (ByteString)
  import Data.Function
  import Data.List
  import Data.List.NonEmpty (NonEmpty)
  import Data.List.NonEmpty qualified as NonEmpty
  import Data.Maybe
  import Data.Text (Text)
  import Data.Text qualified as Text
  import Data.Text.Encoding qualified as Text
  import Graphics.Vty
  import System.Exit
  
  
  data StepState = StepState
    { cmdline :: NonEmpty Text
    , started :: Bool
    , revOutput :: [(OutputChannel, ByteString)]
    , lastTickOutputCount :: !Int
    , outputCount :: !Int
    , exit :: Maybe ExitCode
    }
  
  initStepState :: NonEmpty Text -> StepState
  initStepState cmdline = StepState
    { cmdline
    , started = False
    , revOutput = []
    , lastTickOutputCount = 0
    , outputCount = 0
    , exit = Nothing
    }
  
  stepFromRecording :: StepResult -> StepState -> StepState
  stepFromRecording result ss = ss
    { started = True
    , revOutput = reverse $ second Text.encodeUtf8 <$> result.output
    , exit = Just result.exitCode
    }
  
  statusColor :: StepState -> Color
  statusColor ss = case ss.exit of
    _ | not ss.started -> white
    Nothing -> brightYellow
    Just ExitSuccess -> brightGreen
    Just (ExitFailure _) -> brightRed
  
  stepOutputWidget :: DisplayRegion -> StepState -> Image
  stepOutputWidget (width, height) ss = header <-> output
    where
      commandText = "Command: "
      headerBg = defAttr `withBackColor` blue
      status = headerBg `withForeColor` statusColor ss
      header = vertCat
        [ horizCat $ padToCommonHeight
          [ ( headerBg
            , ' '
            , text' (headerBg `withForeColor` brightYellow) commandText
            )
          , ( headerBg
            , ' '
            , vertCat
              [ resizeWidthFill headerBg ' ' (width - safeWctwidth commandText)
                $ text' headerBg line
              | line <- wrap (width - safeWctwidth commandText)
                $ Text.unwords $ NonEmpty.toList ss.cmdline
              ]
            )
          ]
        , resizeWidthFill headerBg ' ' width
          $ text' (headerBg `withForeColor` brightYellow) "Status: " <|>
            case ss.exit of
              _ | not ss.started -> text' status "Pending"
              Nothing -> text' status "Running"
              Just ExitSuccess -> text' status "Completed successfully"
              Just (ExitFailure code) -> text' status
                $ "Failed with exit code " <> Text.pack (show code)
        , charFill (headerBg `withForeColor` brightYellow) borderEW width 1
        ]
      output = resize width (height - imageHeight header) $ vertCat
        [ text' defAttr line
        | line <- reverse . take (height - imageHeight header) . reverse
          $ wrap width
          $ Text.concat $ Text.decodeUtf8Lenient . snd <$> reverse ss.revOutput
        ]
  
  data TimerEvent = TimerEvent
  
  stepHandleSchedulerEvent :: SchedulerMessage -> StepState -> StepState
  stepHandleSchedulerEvent ev ss = case ev of
    OnStepStarted{} -> ss { started = True }
    OnStepFinished{ exitCode } -> ss { exit = Just exitCode }
    OnOutput{ channel, output } -> ss
      { revOutput = (channel, output):ss.revOutput
      , outputCount = ss.lastTickOutputCount + 1
      }
    OnDone{} -> ss
  
  stepHandleTimerEvent :: TimerEvent -> StepState -> StepState
  stepHandleTimerEvent ev ss = case ev of
    TimerEvent -> ss { lastTickOutputCount = ss.outputCount }
  
  type FlavorState = PerCabalStep StepState
  
  initFlavorState :: PerCabalStep (NonEmpty Text) -> FlavorState
  initFlavorState = fmap initStepState
  
  flavorFromRecording :: FlavorResult -> FlavorState -> FlavorState
  flavorFromRecording result fs = tabulateCabalStep'
    \step -> maybe id stepFromRecording
      (indexCabalStep result.steps step) (indexCabalStep fs step)
  
  flavorHandleSchedulerEvent :: SchedulerMessage -> FlavorState -> FlavorState
  flavorHandleSchedulerEvent ev fs = case ev of
    OnStepStarted{ step }
      -> modifyCabalStep step (stepHandleSchedulerEvent ev) fs
    OnStepFinished{ step }
      -> modifyCabalStep step (stepHandleSchedulerEvent ev) fs
    OnOutput{ step }
      -> modifyCabalStep step (stepHandleSchedulerEvent ev) fs
    OnDone{} -> fs
  
  flavorHandleTimerEvent :: TimerEvent -> FlavorState -> FlavorState
  flavorHandleTimerEvent ev fs
    = tabulateCabalStep' \step -> stepHandleTimerEvent ev $ indexCabalStep fs step
  
  newtype OutputState = OutputState
    { selectedStep :: CabalStep
    }
  
  initOutputState :: FlavorState -> OutputState
  initOutputState fs = OutputState
    { selectedStep = fromMaybe FullBuild $ find
      (\step -> indexCabalStep fs step
        & \ss -> ss.started && ss.exit /= Just ExitSuccess)
      [minBound..maxBound]
    }
  
  outputWidget
    :: DisplayRegion -> PerCabalStep Bool -> FlavorState -> OutputState -> Image
  outputWidget (width, height) enabledSteps fs os = tabSwitcher <-> output
    where
      stepName = \case
        DryRun -> "Planning"
        OnlyDownload -> "Download"
        OnlyDependencies -> "Dependencies"
        FullBuild -> "Build"
      tabSwitcher = horizCat
        [ char defAttr ' ' <|> text'
          (if step == os.selectedStep
            then defAttr `withBackColor` blue
            else defAttr `withBackColor` brightBlack)
          (if ss.started && isNothing ss.exit
            then stepName step <> " " <> outputSpinner ss
            else stepName step)
        | step <- [minBound..maxBound]
        , indexCabalStep enabledSteps step || step == os.selectedStep
        , let ss = indexCabalStep fs step
        ]
      output = stepOutputWidget (width, height - imageHeight tabSwitcher)
        (indexCabalStep fs os.selectedStep)
  
  outputSpinner :: StepState -> Text
  outputSpinner ss = Text.singleton $ "|/-\\" !! (ss.outputCount `mod` 4)
  
  outputHandleEvent
    :: PerCabalStep Bool -> Event -> OutputState -> OutputState
  outputHandleEvent enabledSteps ev os = case ev of
    -- Make sure to do something sensible if all steps are disabled
    EvKey KLeft _ -> os
      { selectedStep = fromMaybe os.selectedStep $ listToMaybe
        [ step
        | step <- reverse [minBound..maxBound]
        , indexCabalStep enabledSteps step
        , step < os.selectedStep
        ]
      }
    EvKey KRight _ -> os
      { selectedStep = fromMaybe os.selectedStep $ listToMaybe
        [ step
        | step <- [minBound..maxBound]
        , indexCabalStep enabledSteps step
        , step > os.selectedStep
        ]
      }
    _ -> os
  
  outputKeybinds :: [(Text, Text)]
  outputKeybinds =
    [ (Text.pack [triangleW, triangleE], "switch build steps")
    ]
  
  matrixCellWidth :: Int
  matrixCellWidth = 10
  
  matrixCellHeight :: Int
  matrixCellHeight = 1
  
  cellWidget :: Bool -> Maybe FlavorState -> Image
  cellWidget focused Nothing = charFill
    (if focused then defAttr `withBackColor` brightBlack else defAttr)
    ' ' matrixCellWidth matrixCellHeight
  cellWidget focused (Just pcs) = resizeWidthFill attr ' ' matrixCellWidth if
    | Just ExitSuccess <- pcs.fullBuild.exit
    -> go FullBuild "build ok"
    | Just (ExitFailure _) <- pcs.fullBuild.exit
    -> go FullBuild "build fail"
    | pcs.fullBuild.started
    -> go FullBuild $ "build " <> outputSpinner pcs.fullBuild
  
    | Just ExitSuccess <- pcs.onlyDependencies.exit
    -> go OnlyDependencies "deps ok"
    | Just (ExitFailure _) <- pcs.onlyDependencies.exit
    -> go OnlyDependencies "deps fail"
    | pcs.onlyDependencies.started
    -> go OnlyDependencies $ "deps " <> outputSpinner pcs.onlyDependencies
  
    | Just ExitSuccess <- pcs.onlyDownload.exit
    -> go OnlyDownload "DL ok"
    | Just (ExitFailure _) <- pcs.onlyDownload.exit
    -> go OnlyDownload "DL fail"
    | pcs.onlyDownload.started
    -> go OnlyDownload $ "DL " <> outputSpinner pcs.onlyDownload
  
    | Just ExitSuccess <- pcs.dryRun.exit
    -> go DryRun "plan ok"
    | Just (ExitFailure _) <- pcs.dryRun.exit
    -> go DryRun "no plan"
    | pcs.dryRun.started
    -> go DryRun $ "plan " <> outputSpinner pcs.dryRun
  
    | otherwise
    -> text' attr "..."
    where
      attr = if focused then defAttr `withBackColor` blue else defAttr
      go step = text' $ attr `withForeColor` if
        -- A failure to --dry-run, that is, to solve package constraints is often
        -- not considered a failure. Rather it indicates that the package bounds
        -- are set up correctly.
        | DryRun <- step
        , Just (ExitFailure _) <- (indexCabalStep pcs step).exit
        -> cyan
        | otherwise
        -> statusColor (indexCabalStep pcs step)
  