{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}
{-|
Description: RESTman as a library

For the data inclined, start with 'AppS' in "Types", which holds all internal RESTman state.
For the logic inclined, start with 'handleEvent', which is the main entry point for state
changes over time.  'startUI' in "UI" is responsible for building the 'Brick.Main.App' record
and wiring everything together.
-}
module Lib
    ( chooseCursor
    , cleanPayload
    , draw
    , focusAttr
    , focusStyle
    , growWith
    , handleEvent
    , doRequest
    , lbsToText
    , moveFocusNext
    , moveFocusPrev
    , noSyntaxFound
    , splitExtraSpace
    , syntaxHighlightResponse
    ) where

-- base
import Data.Bits (xor)
import Data.Foldable (for_)
import Data.List (nub, unsnoc)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Void (Void, absurd)

-- brick
import Brick.Main
  ( hScrollBy
  , halt
  , lookupExtent
  , showCursorNamed
  , suspendAndResume
  , vScrollBy
  , vScrollPage
  , viewportScroll
  )
import Brick.Types
  ( BrickEvent(AppEvent, MouseDown, MouseUp, VtyEvent)
  , CursorLocation
  , Direction(Down, Up)
  , EventM
  , Extent
  , HScrollBarOrientation(OnBottom)
  , Result(image)
  , Size(Fixed)
  , VScrollBarOrientation(OnRight)
  , ViewportType(Both)
  , Widget(Widget, render)
  , attrL
  , emptyResult
  , extentSize
  , extentUpperLeft
  , getContext
  , imageL
  , nestEventM
  )
import Brick.Widgets.Border (borderWithLabel)
import Brick.Widgets.Border.Style (unicodeBold)
import Brick.Widgets.Core
  ( fill
  , hBox
  , hLimit
  , modifyDefAttr
  , padLeftRight
  , raw
  , reportExtent
  , str
  , textWidth
  , translateBy
  , txt
  , vBox
  , vLimit
  , vLimitPercent
  , viewport
  , withBorderStyle
  , withHScrollBars
  , withVScrollBars
  )
import Brick.Widgets.Edit
  ( Editor
  , editContentsL
  , editorText
  , getEditContents
  , handleEditorEvent
  , renderEditor
  )
import Brick.Widgets.List
  ( List
  , handleListEvent
  , listElements
  , listItemHeight
  , listSelectedElement
  , listSelectedL
  , renderList
  )
import qualified Brick.Widgets.List as BrickList
import Brick.Widgets.Table (renderTable, rowBorders, surroundingBorder, table)

-- bytestring
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.ByteString.Lazy (toStrict)
import qualified Data.ByteString.Lazy as LBS

-- case-insensitive
import Data.CaseInsensitive (original)
import qualified Data.CaseInsensitive as CaseInsensitive

-- containers
import qualified Data.Map as Map

-- lens
import Control.Lens
  (ALens', _Just, cloneLens, set, view, (%=), (%~), (&), (.~), (^.), (^?))

-- microlens-mtl
import Lens.Micro.Mtl (zoom)

-- mime-types
import Network.Mime (defaultExtensionMap)

-- mtl
import Control.Monad.State.Class (get, gets, modify, put)

-- skylighting
import Skylighting
  ( Syntax
  , TokenizerConfig(TokenizerConfig)
  , defaultFormatOpts
  , defaultSyntaxMap
  , lookupSyntax
  , pygments
  , tokenize
  )

-- text
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8Lenient, decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.Lazy as LText

-- text-zipper
import Data.Text.Zipper (getText, stringZipper)

-- unliftio
import UnliftIO.Exception (tryAnyDeep)

-- vector
import qualified Data.Vector as Vector

-- wreq
import qualified Network.Wreq as W

-- vty
import Graphics.Vty.Attributes
  (Attr(attrStyle), MaybeDefault(..), Style, currentAttr, reverseVideo)
import qualified Graphics.Vty.Attributes as VA
import Graphics.Vty.Image
  ( Image
  , charFill
  , imageHeight
  , imageWidth
  , utf8Bytestring'
  , vertCat
  , (<->)
  , (<|>)
  )
import qualified Graphics.Vty.Image as VI
import Graphics.Vty.Input.Events
  ( Button(BScrollDown, BScrollUp)
  , Event(EvKey, EvMouseDown)
  , Key(KBackTab, KChar, KDown, KEnter, KEsc, KLeft, KPageDown, KPageUp, KRight, KUp)
  , Modifier(MCtrl, MShift)
  )

-- local libs
import HTTP.Client
  ( Header
  , Method
  , customMethodWith
  , customPayloadMethodWith
  , defaults
  , headers
  , knownMethods
  , responseBody
  , responseHeader
  )
import Skylighting.Format.Vty (formatVty)
import Types

-- | Second argument must be positive.
splitExtraSpace :: RangeInAlign -> Int -> (Int, Int)
splitExtraSpace :: RangeInAlign -> Int -> (Int, Int)
splitExtraSpace RangeInAlign
Min Int
n = (Int
0, Int
n)
splitExtraSpace RangeInAlign
MidL Int
n = let (Int
q, Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 in (Int
q, Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r)
splitExtraSpace RangeInAlign
MidG Int
n = let (Int
q, Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 in (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r, Int
q)
splitExtraSpace RangeInAlign
Max Int
n = (Int
n, Int
0)

{-|
Grows an image to a minimum size by padding it, with original images being aligned as specified
within the larger image.
-}
growWith
  :: (Int -> Int -> Image) -- ^ How to generate wide by vert padding image
  -> Int -- ^ minimum width
  -> WideAlign -- ^ width-wise ("horizontal") alignment
  -> Int -- ^ minimum vert ("height")
  -> VertAlign -- ^ vertical alignment
  -> Image -- ^ original, small image
  -> Image -- ^ resulting, grown image
growWith :: (Int -> Int -> Image)
-> Int -> RangeInAlign -> Int -> RangeInAlign -> Image -> Image
growWith Int -> Int -> Image
fillImage Int
w RangeInAlign
wa Int
v RangeInAlign
va Image
img = [Image] -> Image
vertCat
  [ Int -> Int -> Image
fillImage Int
width Int
topPad
  , Int -> Int -> Image
fillImage Int
leftPad Int
vi Image -> Image -> Image
<|> Image
img Image -> Image -> Image
<|> Int -> Int -> Image
fillImage Int
rightPad Int
vi
  , Int -> Int -> Image
fillImage Int
width Int
bottomPad
  ]
 where
  vi :: Int
vi = Image -> Int
imageHeight Image
img
  vPad :: Int
vPad = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vi)
  (Int
topPad, Int
bottomPad) = RangeInAlign -> Int -> (Int, Int)
splitExtraSpace RangeInAlign
va Int
vPad
  wi :: Int
wi = Image -> Int
imageWidth Image
img
  width :: Int
width = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
w Int
wi
  wPad :: Int
wPad = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wi
  (Int
leftPad, Int
rightPad) = RangeInAlign -> Int -> (Int, Int)
splitExtraSpace RangeInAlign
wa Int
wPad

{- Export?
growTransparent :: Int -> WideAlign -> Int -> VertAlign -> Image -> Image
growTransparent = growWith backgroundFill
-}

{-|
Like 'growWith', but fills the padding with ASCII space characters @\' \'@.
-}
growSpaces :: Int -> WideAlign -> Int -> VertAlign -> Image -> Image
growSpaces :: Int -> RangeInAlign -> Int -> RangeInAlign -> Image -> Image
growSpaces = (Int -> Int -> Image)
-> Int -> RangeInAlign -> Int -> RangeInAlign -> Image -> Image
growWith (Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill Attr
currentAttr Char
' ')

-- | Apply a post-processing function to the rendered 'Image' of a widget without touching any other widget properties.
postprocessImage :: (Image -> Image) -> Widget n -> Widget n
postprocessImage :: forall n. (Image -> Image) -> Widget n -> Widget n
postprocessImage Image -> Image
process Widget n
widget = Widget n
widget{render = (imageL %~ process) <$> render widget}

-- | Lens, focus tracking from app state.
focusL :: Functor f => (AppR -> f AppR) -> AppS -> f AppS
focusL :: forall (f :: * -> *).
Functor f =>
(AppR -> f AppR) -> AppS -> f AppS
focusL AppR -> f AppR
embed AppS
s = (\AppR
newFocus -> AppS
s{focus = newFocus}) (AppR -> AppS) -> f AppR -> f AppS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppR -> f AppR
embed (AppS -> AppR
focus AppS
s)

-- | Lens, method text entry from app state.
methodEditorL :: Functor f => (Editor Method AppR -> f (Editor Method AppR)) -> AppS -> f AppS
methodEditorL :: forall (f :: * -> *).
Functor f =>
(Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS
methodEditorL Editor [Char] AppR -> f (Editor [Char] AppR)
embed AppS
s = (\Editor [Char] AppR
newMethodEditor -> AppS
s{methodEditor = newMethodEditor}) (Editor [Char] AppR -> AppS) -> f (Editor [Char] AppR) -> f AppS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor [Char] AppR -> f (Editor [Char] AppR)
embed (AppS -> Editor [Char] AppR
methodEditor AppS
s)

-- | Lens, method in text entry.
methodL :: Functor f => (Method -> f Method) -> AppS -> f AppS
methodL :: forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> AppS -> f AppS
methodL = (Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS
forall (f :: * -> *).
Functor f =>
(Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS
methodEditorL ((Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS)
-> (([Char] -> f [Char])
    -> Editor [Char] AppR -> f (Editor [Char] AppR))
-> ([Char] -> f [Char])
-> AppS
-> f AppS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextZipper [Char] -> f (TextZipper [Char]))
-> Editor [Char] AppR -> f (Editor [Char] AppR)
forall t1 n t2 (f :: * -> *).
Functor f =>
(TextZipper t1 -> f (TextZipper t2))
-> Editor t1 n -> f (Editor t2 n)
editContentsL ((TextZipper [Char] -> f (TextZipper [Char]))
 -> Editor [Char] AppR -> f (Editor [Char] AppR))
-> (([Char] -> f [Char])
    -> TextZipper [Char] -> f (TextZipper [Char]))
-> ([Char] -> f [Char])
-> Editor [Char] AppR
-> f (Editor [Char] AppR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> f [Char]) -> TextZipper [Char] -> f (TextZipper [Char])
forall {f :: * -> *} {a}.
Functor f =>
([a] -> f [Char]) -> TextZipper [a] -> f (TextZipper [Char])
methodInEditorContentsL
 where
  methodInEditorContentsL :: ([a] -> f [Char]) -> TextZipper [a] -> f (TextZipper [Char])
methodInEditorContentsL [a] -> f [Char]
embed TextZipper [a]
tz = (\[Char]
newMethod -> [[Char]] -> Maybe Int -> TextZipper [Char]
stringZipper [[Char]
newMethod] (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)) ([Char] -> TextZipper [Char]) -> f [Char] -> f (TextZipper [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [Char]
embed ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ TextZipper [a] -> [[a]]
forall a. Monoid a => TextZipper a -> [a]
getText TextZipper [a]
tz)

-- | Lens, optional overlay in app state
overlayStateL :: Functor f => (Maybe OverlayS -> f (Maybe OverlayS)) -> AppS -> f AppS
overlayStateL :: forall (f :: * -> *).
Functor f =>
(Maybe OverlayS -> f (Maybe OverlayS)) -> AppS -> f AppS
overlayStateL Maybe OverlayS -> f (Maybe OverlayS)
embed AppS
s = (\Maybe OverlayS
newOverlay -> AppS
s{overlayState = newOverlay}) (Maybe OverlayS -> AppS) -> f (Maybe OverlayS) -> f AppS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OverlayS -> f (Maybe OverlayS)
embed (AppS -> Maybe OverlayS
overlayState AppS
s)

-- | Lens, location of pop-up in overlay state
methodEditorExtentL :: Functor f => (Extent AppR -> f (Extent AppR)) -> OverlayS -> f OverlayS
methodEditorExtentL :: forall (f :: * -> *).
Functor f =>
(Extent AppR -> f (Extent AppR)) -> OverlayS -> f OverlayS
methodEditorExtentL Extent AppR -> f (Extent AppR)
embed OverlayS
os = (\Extent AppR
newExtent -> OverlayS
os{methodEditorExtent = newExtent}) (Extent AppR -> OverlayS) -> f (Extent AppR) -> f OverlayS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extent AppR -> f (Extent AppR)
embed (OverlayS -> Extent AppR
methodEditorExtent OverlayS
os)

-- | Lens, method selector in overlay state
methodListL :: Functor f => (List AppR Method -> f (List AppR Method)) -> OverlayS -> f OverlayS
methodListL :: forall (f :: * -> *).
Functor f =>
(GenericList AppR Vector [Char]
 -> f (GenericList AppR Vector [Char]))
-> OverlayS -> f OverlayS
methodListL GenericList AppR Vector [Char]
-> f (GenericList AppR Vector [Char])
embed OverlayS
os = (\GenericList AppR Vector [Char]
newList -> OverlayS
os{methodList = newList}) (GenericList AppR Vector [Char] -> OverlayS)
-> f (GenericList AppR Vector [Char]) -> f OverlayS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericList AppR Vector [Char]
-> f (GenericList AppR Vector [Char])
embed (OverlayS -> GenericList AppR Vector [Char]
methodList OverlayS
os)

-- | Lens, URL text entry in app state
urlEditorL :: Functor f => (Editor String AppR -> f (Editor String AppR)) -> AppS -> f AppS
urlEditorL :: forall (f :: * -> *).
Functor f =>
(Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS
urlEditorL Editor [Char] AppR -> f (Editor [Char] AppR)
embed AppS
s = (\Editor [Char] AppR
newUrlEditor -> AppS
s{urlEditor = newUrlEditor}) (Editor [Char] AppR -> AppS) -> f (Editor [Char] AppR) -> f AppS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor [Char] AppR -> f (Editor [Char] AppR)
embed (AppS -> Editor [Char] AppR
urlEditor AppS
s)

-- | Lens, flag to use default headers
useDefaultHeadersL :: Functor f => (Bool -> f Bool) -> AppS -> f AppS
useDefaultHeadersL :: forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppS -> f AppS
useDefaultHeadersL Bool -> f Bool
embed AppS
s =
  (\Bool
newUse -> AppS
s{useDefaultHeaders = newUse}) (Bool -> AppS) -> f Bool -> f AppS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
embed (AppS -> Bool
useDefaultHeaders AppS
s)

-- | Lens, custom headers
customHeadersL :: Functor f => ([(Bool, Header)] -> f [(Bool, Header)]) -> AppS -> f AppS
customHeadersL :: forall (f :: * -> *).
Functor f =>
([(Bool, Header)] -> f [(Bool, Header)]) -> AppS -> f AppS
customHeadersL [(Bool, Header)] -> f [(Bool, Header)]
embed AppS
s =
  (\[(Bool, Header)]
newHeaders -> AppS
s {customHeaders = newHeaders}) ([(Bool, Header)] -> AppS) -> f [(Bool, Header)] -> f AppS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bool, Header)] -> f [(Bool, Header)]
embed (AppS -> [(Bool, Header)]
customHeaders AppS
s)

-- | Lens, header editor (maybe)
headerEditorL :: Functor f => (Maybe (Editor Text AppR) -> f (Maybe (Editor Text AppR))) -> AppS -> f AppS
headerEditorL :: forall (f :: * -> *).
Functor f =>
(Maybe (Editor Text AppR) -> f (Maybe (Editor Text AppR)))
-> AppS -> f AppS
headerEditorL Maybe (Editor Text AppR) -> f (Maybe (Editor Text AppR))
embed AppS
s =
  (\Maybe (Editor Text AppR)
newHEdit -> AppS
s { headerEditor = newHEdit }) (Maybe (Editor Text AppR) -> AppS)
-> f (Maybe (Editor Text AppR)) -> f AppS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Editor Text AppR) -> f (Maybe (Editor Text AppR))
embed (AppS -> Maybe (Editor Text AppR)
headerEditor AppS
s)

{-|
Like 'borderWithLabel' but grows the image of the inner widget so the whole label is always
visible.
-}
textLabeledBorder ::  Text -> Widget n -> Widget n
textLabeledBorder :: forall n. Text -> Widget n -> Widget n
textLabeledBorder Text
label Widget n
inner =
  Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget n
forall n. Text -> Widget n
txt Text
label) ((Image -> Image) -> Widget n -> Widget n
forall n. (Image -> Image) -> Widget n -> Widget n
postprocessImage (Int -> RangeInAlign -> Int -> RangeInAlign -> Image -> Image
growSpaces (Text -> Int
forall a. TextWidth a => a -> Int
textWidth Text
label) RangeInAlign
left Int
0 RangeInAlign
top) Widget n
inner)

-- | Area between main menu and main content area
mainMenuSeparator :: Widget n
mainMenuSeparator :: forall n. Widget n
mainMenuSeparator = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
forall n. Char -> Widget n
fill Char
'='

-- | Non-functional top menu bar
mainMenu :: Widget n
mainMenu :: forall n. Widget n
mainMenu = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
2 (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt) [ Text
"Headers", Text
"Response Tools", Text
"\x2026" ]

{-|
Intermediate record that bundles all focus-sensitive widgets built during a single 'draw' call.

Each field holds a pre-built widget; 'draw' selects the appropriate focused variant by
overriding the relevant field based on the current 'focus' in 'AppS'.
-}
data FocusSensitive = MkFocusSensitive
  { FocusSensitive -> Widget AppR
methodWidget :: Widget AppR
  , FocusSensitive -> Widget AppR
urlWidget :: Widget AppR
  , FocusSensitive -> Widget AppR
defaultHeadersToggleWidget :: Widget AppR
  , FocusSensitive -> [[Widget AppR]]
customHeadersWidgets :: [[Widget AppR]]
  , FocusSensitive -> Widget AppR
addCustomHeaderWidget :: Widget AppR
  , FocusSensitive -> Widget AppR
responseBodyWidget :: Widget AppR
  }

{-|
Render.

Widget names are all 'AppR'.

URL editor and label, then last response body at the top of the available space.  No other widgets
or layers.
-}
draw :: AppS -> [Widget AppR]
draw :: AppS -> [Widget AppR]
draw AppS{Bool
[(Bool, Header)]
Maybe ByteString
Maybe (Editor Text AppR)
Maybe OverlayS
Editor [Char] AppR
Manager
Image
AppR
focus :: AppS -> AppR
methodEditor :: AppS -> Editor [Char] AppR
overlayState :: AppS -> Maybe OverlayS
urlEditor :: AppS -> Editor [Char] AppR
useDefaultHeaders :: AppS -> Bool
customHeaders :: AppS -> [(Bool, Header)]
headerEditor :: AppS -> Maybe (Editor Text AppR)
focus :: AppR
methodEditor :: Editor [Char] AppR
overlayState :: Maybe OverlayS
urlEditor :: Editor [Char] AppR
lastResponse :: Image
useDefaultHeaders :: Bool
customHeaders :: [(Bool, Header)]
headerEditor :: Maybe (Editor Text AppR)
payload :: Maybe ByteString
connManager :: Manager
connManager :: AppS -> Manager
payload :: AppS -> Maybe ByteString
lastResponse :: AppS -> Image
..} =
  [ OverlayS -> Widget AppR
drawOverlay OverlayS
os | Just OverlayS
os <- [Maybe OverlayS
overlayState] ]
  [Widget AppR] -> [Widget AppR] -> [Widget AppR]
forall a. [a] -> [a] -> [a]
++
  [ [Widget AppR] -> Widget AppR
forall n. [Widget n] -> Widget n
vBox ([Widget AppR] -> Widget AppR) -> [Widget AppR] -> Widget AppR
forall a b. (a -> b) -> a -> b
$
    [ Widget AppR
forall n. Widget n
mainMenu
    , Widget AppR
forall n. Widget n
mainMenuSeparator
    , [Widget AppR] -> Widget AppR
forall n. [Widget n] -> Widget n
hBox
      [ AppR -> Widget AppR -> Widget AppR
forall n. Ord n => n -> Widget n -> Widget n
reportExtent AppR
MethodEditor (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall a b. (a -> b) -> a -> b
$ Text -> Widget AppR -> Widget AppR
forall n. Text -> Widget n -> Widget n
textLabeledBorder Text
"Method" Widget AppR
methodWidget
      , Text -> Widget AppR -> Widget AppR
forall n. Text -> Widget n -> Widget n
textLabeledBorder Text
"URL to Query?" Widget AppR
urlWidget
      ]
    , Widget AppR
defaultHeadersSection
    ]
    [Widget AppR] -> [Widget AppR] -> [Widget AppR]
forall a. [a] -> [a] -> [a]
++
    [ Text -> Widget AppR -> Widget AppR
forall n. Text -> Widget n -> Widget n
textLabeledBorder Text
"Custom Headers"
      (Widget AppR -> Widget AppR)
-> ([[Widget AppR]] -> Widget AppR)
-> [[Widget AppR]]
-> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table AppR -> Widget AppR
forall n. Table n -> Widget n
renderTable
      (Table AppR -> Widget AppR)
-> ([[Widget AppR]] -> Table AppR)
-> [[Widget AppR]]
-> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table AppR -> Table AppR
forall n. Bool -> Table n -> Table n
surroundingBorder Bool
False
      (Table AppR -> Table AppR)
-> ([[Widget AppR]] -> Table AppR) -> [[Widget AppR]] -> Table AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table AppR -> Table AppR
forall n. Bool -> Table n -> Table n
rowBorders Bool
False
      (Table AppR -> Table AppR)
-> ([[Widget AppR]] -> Table AppR) -> [[Widget AppR]] -> Table AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Widget AppR]] -> Table AppR
forall n. [[Widget n]] -> Table n
table
      ([[Widget AppR]] -> Widget AppR) -> [[Widget AppR]] -> Widget AppR
forall a b. (a -> b) -> a -> b
$ [[Widget AppR]]
customHeadersWidgets [[Widget AppR]] -> [[Widget AppR]] -> [[Widget AppR]]
forall a. [a] -> [a] -> [a]
++ [[Widget AppR
addCustomHeaderWidget, Text -> Widget AppR
forall n. Text -> Widget n
txt Text
"", Text -> Widget AppR
forall n. Text -> Widget n
txt Text
""]]
    ]
    [Widget AppR] -> [Widget AppR] -> [Widget AppR]
forall a. [a] -> [a] -> [a]
++
    [ Widget AppR
responseBodyWidget ]
  ] -- layers top to bottom
 where
  unfocusedWidgets :: FocusSensitive
unfocusedWidgets = MkFocusSensitive
    { methodWidget :: Widget AppR
methodWidget = Bool -> Widget AppR
methodEditorWidget Bool
False
    , urlWidget :: Widget AppR
urlWidget = Bool -> Editor [Char] AppR -> Widget AppR
editorWidget Bool
False Editor [Char] AppR
urlEditor
    , defaultHeadersToggleWidget :: Widget AppR
defaultHeadersToggleWidget = Widget AppR
defaultHeadersToggle
    , customHeadersWidgets :: [[Widget AppR]]
customHeadersWidgets = ((Bool, Header) -> [Widget AppR])
-> [(Bool, Header)] -> [[Widget AppR]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Header) -> [Widget AppR]
forall {n}. (Bool, Header) -> [Widget n]
unfocusedHeader [(Bool, Header)]
customHeaders
    , addCustomHeaderWidget :: Widget AppR
addCustomHeaderWidget = Widget AppR
forall n. Widget n
addCustomHeader
    , responseBodyWidget :: Widget AppR
responseBodyWidget = Widget AppR
responseBodyView
    }
  methodEditorWidget :: Bool -> Widget AppR
methodEditorWidget Bool
isFocused = Int -> Widget AppR -> Widget AppR
forall n. Int -> Widget n -> Widget n
hLimit Int
18 (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall a b. (a -> b) -> a -> b
$ [Widget AppR] -> Widget AppR
forall n. [Widget n] -> Widget n
hBox [Bool -> Editor [Char] AppR -> Widget AppR
editorWidget Bool
isFocused Editor [Char] AppR
methodEditor, [Char] -> Widget AppR
forall n. [Char] -> Widget n
str [Char]
"\x25BC"]
  editorWidget :: Bool -> Editor [Char] AppR -> Widget AppR
editorWidget = ([[Char]] -> Widget AppR)
-> Bool -> Editor [Char] AppR -> Widget AppR
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor ([Widget AppR] -> Widget AppR
forall n. [Widget n] -> Widget n
vBox ([Widget AppR] -> Widget AppR)
-> ([[Char]] -> [Widget AppR]) -> [[Char]] -> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Widget AppR) -> [[Char]] -> [Widget AppR]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Widget AppR
forall n. [Char] -> Widget n
str)
  usingDefaultHeadersText :: Text
usingDefaultHeadersText = Text
"[X] Use Default Headers"
  (Widget AppR
defaultHeadersToggle, Widget AppR
defaultHeadersSection) =
    if Bool
useDefaultHeaders
     then
      ( Text -> Widget AppR
forall n. Text -> Widget n
txt Text
usingDefaultHeadersText
      , Widget AppR -> Widget AppR -> Widget AppR
forall n. Widget n -> Widget n -> Widget n
borderWithLabel
          Widget AppR
defaultHeadersToggleWidget
          ((Image -> Image) -> Widget AppR -> Widget AppR
forall n. (Image -> Image) -> Widget n -> Widget n
postprocessImage (Int -> RangeInAlign -> Int -> RangeInAlign -> Image -> Image
growSpaces (Text -> Int
forall a. TextWidth a => a -> Int
textWidth Text
usingDefaultHeadersText) RangeInAlign
left Int
0 RangeInAlign
top) ([Header] -> Widget AppR
forall n. [Header] -> Widget n
headersWidget [Header]
defaultHeaders))
      )
     else (Text -> Widget AppR
forall n. Text -> Widget n
txt Text
"[ ] Use Default Headers", Widget AppR
defaultHeadersToggleWidget)
   where
    defaultHeaders :: [Header]
defaultHeaders = Getting [Header] Options [Header] -> Options -> [Header]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Header] Options [Header]
Lens' Options [Header]
headers Options
defaults
  unfocusedHeader :: (Bool, Header) -> [Widget n]
unfocusedHeader (Bool
active, (CI ByteString
n, ByteString
v)) = [Bool -> Widget n
forall {n}. Bool -> Widget n
unfocusedActive Bool
active, CI ByteString -> Widget n
forall {n}. CI ByteString -> Widget n
unfocusedName CI ByteString
n, ByteString -> Widget n
forall n. ByteString -> Widget n
utf8 ByteString
v ]
  unfocusedActive :: Bool -> Widget n
unfocusedActive Bool
active = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> (Char -> Text) -> Char -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton (Char -> Widget n) -> Char -> Widget n
forall a b. (a -> b) -> a -> b
$ if Bool
active then Char
'X' else Char
' '
  unfocusedName :: CI ByteString -> Widget n
unfocusedName = ByteString -> Widget n
forall n. ByteString -> Widget n
utf8 (ByteString -> Widget n)
-> (CI ByteString -> ByteString) -> CI ByteString -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString
forall s. CI s -> s
original
  addCustomHeader :: Widget n
addCustomHeader = Text -> Widget n
forall n. Text -> Widget n
txt Text
"+"
  responseBodyView :: Widget AppR
responseBodyView =
    Text -> Widget AppR -> Widget AppR
forall n. Text -> Widget n -> Widget n
textLabeledBorder Text
"Response Body"
    (Widget AppR -> Widget AppR)
-> (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScrollBarOrientation -> Widget AppR -> Widget AppR
forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight
    (Widget AppR -> Widget AppR)
-> (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HScrollBarOrientation -> Widget AppR -> Widget AppR
forall n. HScrollBarOrientation -> Widget n -> Widget n
withHScrollBars HScrollBarOrientation
OnBottom
    (Widget AppR -> Widget AppR)
-> (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppR -> ViewportType -> Widget AppR -> Widget AppR
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport AppR
ResponseBodyView ViewportType
Both
    (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall a b. (a -> b) -> a -> b
$ Image -> Widget AppR
forall n. Image -> Widget n
raw Image
lastResponse
  MkFocusSensitive{[[Widget AppR]]
Widget AppR
methodWidget :: FocusSensitive -> Widget AppR
urlWidget :: FocusSensitive -> Widget AppR
defaultHeadersToggleWidget :: FocusSensitive -> Widget AppR
customHeadersWidgets :: FocusSensitive -> [[Widget AppR]]
addCustomHeaderWidget :: FocusSensitive -> Widget AppR
responseBodyWidget :: FocusSensitive -> Widget AppR
methodWidget :: Widget AppR
urlWidget :: Widget AppR
customHeadersWidgets :: [[Widget AppR]]
addCustomHeaderWidget :: Widget AppR
responseBodyWidget :: Widget AppR
defaultHeadersToggleWidget :: Widget AppR
..} = case AppR
focus of
    AppR
MethodEditor -> FocusSensitive
unfocusedWidgets { methodWidget = methodEditorWidget True }
    AppR
UrlEditor -> FocusSensitive
unfocusedWidgets { urlWidget = editorWidget True urlEditor }
    AppR
DefaultHeadersToggle -> FocusSensitive
unfocusedWidgets { defaultHeadersToggleWidget = focusWidget defaultHeadersToggle }
    ExistingCustomHeader CustomHeaderR
chResource -> FocusSensitive
unfocusedWidgets { customHeadersWidgets = customHeadersWithFocus chResource }
    AppR
AddCustomHeader -> FocusSensitive
unfocusedWidgets { addCustomHeaderWidget = focusWidget addCustomHeader }
    AppR
ResponseBodyView -> FocusSensitive
unfocusedWidgets { responseBodyWidget = withBorderStyle unicodeBold responseBodyView }
    AppR
MethodSelector -> FocusSensitive
unfocusedWidgets
  customHeadersWithFocus :: CustomHeaderR -> [[Widget AppR]]
customHeadersWithFocus MkCustomHeaderR{Int
CustomHeaderColumn
listIndex :: Int
column :: CustomHeaderColumn
column :: CustomHeaderR -> CustomHeaderColumn
listIndex :: CustomHeaderR -> Int
..} = (Int -> (Bool, Header) -> [Widget AppR])
-> [Int] -> [(Bool, Header)] -> [[Widget AppR]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Bool, Header) -> [Widget AppR]
headerRow [Int
0..] [(Bool, Header)]
customHeaders
   where
    headerRow :: Int -> (Bool, Header) -> [Widget AppR]
headerRow Int
i = if Int
listIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then (Bool, Header) -> [Widget AppR]
focusedRow else (Bool, Header) -> [Widget AppR]
forall {n}. (Bool, Header) -> [Widget n]
unfocusedHeader
    focusedRow :: (Bool, Header) -> [Widget AppR]
focusedRow (Bool
active, (CI ByteString
n, ByteString
v)) = case CustomHeaderColumn
column of
      CustomHeaderColumn
ActiveToggle -> [Widget AppR -> Widget AppR
forall n. Widget n -> Widget n
focusWidget Widget AppR
activeWidget, Widget AppR
nameWidget, Widget AppR
valueWidget]
      CustomHeaderColumn
NameEditor -> [Widget AppR
activeWidget, Widget AppR
-> (Editor Text AppR -> Widget AppR)
-> Maybe (Editor Text AppR)
-> Widget AppR
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Widget AppR -> Widget AppR
forall n. Widget n -> Widget n
focusWidget Widget AppR
nameWidget) Editor Text AppR -> Widget AppR
forall {n}. (Ord n, Show n) => Editor Text n -> Widget n
renderHeaderEditor Maybe (Editor Text AppR)
headerEditor, Widget AppR
valueWidget]
      CustomHeaderColumn
ValueEditor -> [Widget AppR
activeWidget, Widget AppR
nameWidget, Widget AppR
-> (Editor Text AppR -> Widget AppR)
-> Maybe (Editor Text AppR)
-> Widget AppR
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Widget AppR -> Widget AppR
forall n. Widget n -> Widget n
focusWidget Widget AppR
valueWidget) Editor Text AppR -> Widget AppR
forall {n}. (Ord n, Show n) => Editor Text n -> Widget n
renderHeaderEditor Maybe (Editor Text AppR)
headerEditor]
     where
      activeWidget :: Widget AppR
activeWidget = Bool -> Widget AppR
forall {n}. Bool -> Widget n
unfocusedActive Bool
active
      nameWidget :: Widget AppR
nameWidget = CI ByteString -> Widget AppR
forall {n}. CI ByteString -> Widget n
unfocusedName CI ByteString
n
      valueWidget :: Widget AppR
valueWidget = ByteString -> Widget AppR
forall n. ByteString -> Widget n
utf8 ByteString
v
      renderHeaderEditor :: Editor Text n -> Widget n
renderHeaderEditor Editor Text n
hedit =
        Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit ((Text -> Int -> Int) -> Int -> [Text] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (Text -> Int) -> Text -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
forall a. TextWidth a => a -> Int
textWidth) Int
1 ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ Editor Text n -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text n
hedit)
        (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1
        (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ([Text] -> Widget n) -> Bool -> Editor Text n -> Widget n
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor ([Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> ([Text] -> [Widget n]) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget n
forall n. Text -> Widget n
txt) Bool
True Editor Text n
hedit

-- | Toggle the @reverseVideo@ bit in a 'Style' to indicate keyboard focus.
focusStyle :: Style -> Style
focusStyle :: Style -> Style
focusStyle Style
x = Style
x Style -> Style -> Style
forall a. Bits a => a -> a -> a
`xor` Style
reverseVideo

-- | Apply 'focusStyle' to the style component of an 'Attr', setting it explicitly if it was @Default@ or @KeepCurrent@.
focusAttr :: Attr -> Attr
focusAttr :: Attr -> Attr
focusAttr Attr
attr = Attr
attr { attrStyle = SetTo newStyle }
 where
  newStyle :: Style
newStyle = case Attr -> MaybeDefault Style
attrStyle Attr
attr of
    MaybeDefault Style
Default -> Style
reverseVideo
    MaybeDefault Style
KeepCurrent -> Style
reverseVideo
    SetTo Style
style -> Style -> Style
focusStyle Style
style

-- | Modify the default attribute of a widget using 'focusAttr' to visually highlight it as focused.
focusWidget :: Widget n -> Widget n
focusWidget :: forall n. Widget n -> Widget n
focusWidget = (Attr -> Attr) -> Widget n -> Widget n
forall n. (Attr -> Attr) -> Widget n -> Widget n
modifyDefAttr Attr -> Attr
focusAttr

-- | Render a raw UTF-8 'ByteString' as a fixed-size Brick widget using the current attribute.
utf8 :: ByteString -> Widget n
utf8 :: forall n. ByteString -> Widget n
utf8 ByteString
bytes = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
  c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
  return emptyResult { image = utf8Bytestring' (c ^. attrL) bytes }

-- | Render a list of HTTP 'Header' pairs as a borderless two-column table.
headersWidget :: [Header] -> Widget n
headersWidget :: forall n. [Header] -> Widget n
headersWidget = Table n -> Widget n
forall n. Table n -> Widget n
renderTable (Table n -> Widget n)
-> ([Header] -> Table n) -> [Header] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
surroundingBorder Bool
False (Table n -> Table n)
-> ([Header] -> Table n) -> [Header] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
rowBorders Bool
False (Table n -> Table n)
-> ([Header] -> Table n) -> [Header] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Widget n]] -> Table n
forall n. [[Widget n]] -> Table n
table ([[Widget n]] -> Table n)
-> ([Header] -> [[Widget n]]) -> [Header] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> [Widget n]) -> [Header] -> [[Widget n]]
forall a b. (a -> b) -> [a] -> [b]
map Header -> [Widget n]
forall {n}. Header -> [Widget n]
headerRow
 where
  headerRow :: Header -> [Widget n]
headerRow (CI ByteString
n, ByteString
v) = [ByteString -> Widget n
forall n. ByteString -> Widget n
utf8 (ByteString -> Widget n) -> ByteString -> Widget n
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
n, ByteString -> Widget n
forall n. ByteString -> Widget n
utf8 ByteString
v]

-- | When the overlay is present, what are the widget to draw on that layer.
drawOverlay :: OverlayS -> Widget AppR
drawOverlay :: OverlayS -> Widget AppR
drawOverlay OverlayS{Extent AppR
GenericList AppR Vector [Char]
methodEditorExtent :: OverlayS -> Extent AppR
methodList :: OverlayS -> GenericList AppR Vector [Char]
methodEditorExtent :: Extent AppR
methodList :: GenericList AppR Vector [Char]
..} =
  Location -> Widget AppR -> Widget AppR
forall n. Location -> Widget n -> Widget n
translateBy Location
transLoc (Widget AppR -> Widget AppR)
-> (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget AppR -> Widget AppR
forall n. Int -> Widget n -> Widget n
hLimit Int
w (Widget AppR -> Widget AppR)
-> (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget AppR -> Widget AppR
forall n. Text -> Widget n -> Widget n
textLabeledBorder Text
"Method (Select)" (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall a b. (a -> b) -> a -> b
$ Widget AppR
methodSelectWidget
 where
  methodSelectWidget :: Widget AppR
methodSelectWidget = Int -> Widget AppR -> Widget AppR
forall n. Int -> Widget n -> Widget n
vLimitPercent Int
50 (Widget AppR -> Widget AppR)
-> (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget AppR -> Widget AppR
forall n. Int -> Widget n -> Widget n
vLimit Int
mv (Widget AppR -> Widget AppR) -> Widget AppR -> Widget AppR
forall a b. (a -> b) -> a -> b
$ (Bool -> [Char] -> Widget AppR)
-> Bool -> GenericList AppR Vector [Char] -> Widget AppR
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList (([Char] -> Widget AppR) -> Bool -> [Char] -> Widget AppR
forall a b. a -> b -> a
const [Char] -> Widget AppR
forall n. [Char] -> Widget n
str) Bool
True GenericList AppR Vector [Char]
methodList
  w :: Int
w = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Extent AppR -> (Int, Int)
forall n. Extent n -> (Int, Int)
extentSize Extent AppR
methodEditorExtent
  transLoc :: Location
transLoc = Extent AppR -> Location
forall n. Extent n -> Location
extentUpperLeft Extent AppR
methodEditorExtent
  mv :: Int
mv = Vector [Char] -> Int
forall a. Vector a -> Int
Vector.length (GenericList AppR Vector [Char] -> Vector [Char]
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList AppR Vector [Char]
methodList) Int -> Int -> Int
forall a. Num a => a -> a -> a
* GenericList AppR Vector [Char] -> Int
forall n (t :: * -> *) e. GenericList n t e -> Int
listItemHeight GenericList AppR Vector [Char]
methodList

-- | Where to place the cursor?  If overlay present, no cursor.  Otherwise determined by 'focus'
chooseCursor :: AppS -> [CursorLocation AppR] -> Maybe (CursorLocation AppR)
chooseCursor :: AppS -> [CursorLocation AppR] -> Maybe (CursorLocation AppR)
chooseCursor AppS
s = AppR -> [CursorLocation AppR] -> Maybe (CursorLocation AppR)
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed (AppR -> [CursorLocation AppR] -> Maybe (CursorLocation AppR))
-> AppR -> [CursorLocation AppR] -> Maybe (CursorLocation AppR)
forall a b. (a -> b) -> a -> b
$ case AppS -> Maybe OverlayS
overlayState AppS
s of
  Maybe OverlayS
Nothing -> AppS -> AppR
focus AppS
s
  Just OverlayS
_ -> AppR
MethodSelector

-- | App state change on [Tab] to advace the focus.
moveFocusNext :: AppS -> AppS
moveFocusNext :: AppS -> AppS
moveFocusNext AppS
s = [(Bool, Header)] -> AppR -> AppS -> AppS
focusNext (AppS -> [(Bool, Header)]
customHeaders AppS
s) (AppS -> AppR
focus AppS
s) AppS
s
 where
  focusNext :: [(Bool, Header)] -> AppR -> AppS -> AppS
focusNext [(Bool, Header)]
cheaders = \case
    AppR
MethodEditor -> (AppR -> Identity AppR) -> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
(AppR -> f AppR) -> AppS -> f AppS
focusL ((AppR -> Identity AppR) -> AppS -> Identity AppS)
-> AppR -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppR
UrlEditor
    AppR
UrlEditor -> (AppR -> Identity AppR) -> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
(AppR -> f AppR) -> AppS -> f AppS
focusL ((AppR -> Identity AppR) -> AppS -> Identity AppS)
-> AppR -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppR
DefaultHeadersToggle
    AppR
DefaultHeadersToggle -> (AppR -> Identity AppR) -> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
(AppR -> f AppR) -> AppS -> f AppS
focusL ((AppR -> Identity AppR) -> AppS -> Identity AppS)
-> AppR -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppR
nextFocus
     where
      nextFocus :: AppR
nextFocus =
        if [(Bool, Header)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, Header)]
cheaders
         then AppR
AddCustomHeader
         else CustomHeaderR -> AppR
ExistingCustomHeader MkCustomHeaderR { listIndex :: Int
listIndex = Int
0, column :: CustomHeaderColumn
column = CustomHeaderColumn
ActiveToggle }
    ExistingCustomHeader MkCustomHeaderR{Int
CustomHeaderColumn
column :: CustomHeaderR -> CustomHeaderColumn
listIndex :: CustomHeaderR -> Int
listIndex :: Int
column :: CustomHeaderColumn
..} -> \AppS
os -> case Int -> [(Bool, Header)] -> ([(Bool, Header)], [(Bool, Header)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
listIndex [(Bool, Header)]
cheaders of
      ([(Bool, Header)]
initHdrs, (Bool
flag, (CI ByteString
name, ByteString
value)) : [(Bool, Header)]
tailHdrs) -> case CustomHeaderColumn
column of
        CustomHeaderColumn
ActiveToggle -> AppS
os
          { focus = nextFocus
          , headerEditor = Just $ editorText nextFocus (Just 1) (decodeUtf8Lenient $ original name)
          }
         where
          nextFocus :: AppR
nextFocus = CustomHeaderR -> AppR
ExistingCustomHeader MkCustomHeaderR { Int
listIndex :: Int
listIndex :: Int
listIndex, column :: CustomHeaderColumn
column = CustomHeaderColumn
NameEditor }
        CustomHeaderColumn
NameEditor -> AppS
os
          { focus = nextFocus
          , headerEditor = Just $ editorText nextFocus (Just 1) (decodeUtf8Lenient value)
          , customHeaders =
              initHdrs
              ++ (flag, (maybe name (CaseInsensitive.mk . getEditorUtf8) (headerEditor os), value))
              : tailHdrs
          }
         where
          nextFocus :: AppR
nextFocus = CustomHeaderR -> AppR
ExistingCustomHeader MkCustomHeaderR { Int
listIndex :: Int
listIndex :: Int
listIndex, column :: CustomHeaderColumn
column = CustomHeaderColumn
ValueEditor }
        CustomHeaderColumn
ValueEditor ->
          if [(Bool, Header)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, Header)]
tailHdrs
           then AppS
os
            { focus = AddCustomHeader
            , headerEditor = Nothing
            , customHeaders =
                initHdrs ++ [(flag, (name, valueViaEditor))]
            }
           else AppS
os
            { focus = ExistingCustomHeader MkCustomHeaderR { listIndex = succ listIndex, column = ActiveToggle }
            , headerEditor = Nothing
            , customHeaders =
                initHdrs ++ (flag, (name, valueViaEditor)) : tailHdrs
            }
         where
          valueViaEditor :: ByteString
valueViaEditor = ByteString
-> (Editor Text AppR -> ByteString)
-> Maybe (Editor Text AppR)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
value Editor Text AppR -> ByteString
forall n. Editor Text n -> ByteString
getEditorUtf8 (AppS -> Maybe (Editor Text AppR)
headerEditor AppS
os)
      ([(Bool, Header)], [(Bool, Header)])
_ -> AppS
os { focus = AddCustomHeader, headerEditor = Nothing } -- NB: invalid focus
    AppR
AddCustomHeader -> (AppR -> Identity AppR) -> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
(AppR -> f AppR) -> AppS -> f AppS
focusL ((AppR -> Identity AppR) -> AppS -> Identity AppS)
-> AppR -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppR
ResponseBodyView
    AppR
ResponseBodyView -> (AppR -> Identity AppR) -> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
(AppR -> f AppR) -> AppS -> f AppS
focusL ((AppR -> Identity AppR) -> AppS -> Identity AppS)
-> AppR -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppR
MethodEditor
    AppR
MethodSelector -> (AppR -> Identity AppR) -> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
(AppR -> f AppR) -> AppS -> f AppS
focusL ((AppR -> Identity AppR) -> AppS -> Identity AppS)
-> AppR -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppR
MethodEditor -- NB: invalid focus

-- | App state change on [S+Tab] to recede the focus
moveFocusPrev :: AppS -> AppS
moveFocusPrev :: AppS -> AppS
moveFocusPrev AppS
s = case AppS -> AppR
focus AppS
s of
  AppR
MethodEditor -> AppS
s { focus = ResponseBodyView }
  AppR
UrlEditor -> AppS
s { focus = MethodEditor }
  AppR
DefaultHeadersToggle -> AppS
s { focus = UrlEditor }
  ExistingCustomHeader MkCustomHeaderR { Int
CustomHeaderColumn
column :: CustomHeaderR -> CustomHeaderColumn
listIndex :: CustomHeaderR -> Int
listIndex :: Int
column :: CustomHeaderColumn
.. } -> case Int -> [(Bool, Header)] -> ([(Bool, Header)], [(Bool, Header)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
listIndex ([(Bool, Header)] -> ([(Bool, Header)], [(Bool, Header)]))
-> [(Bool, Header)] -> ([(Bool, Header)], [(Bool, Header)])
forall a b. (a -> b) -> a -> b
$ AppS -> [(Bool, Header)]
customHeaders AppS
s of
    ([(Bool, Header)]
initHdrs, (Bool
flag, (CI ByteString
name, ByteString
value)) : [(Bool, Header)]
tailHdrs) -> case CustomHeaderColumn
column of
      CustomHeaderColumn
ActiveToggle -> case [(Bool, Header)] -> Maybe ([(Bool, Header)], (Bool, Header))
forall a. [a] -> Maybe ([a], a)
unsnoc [(Bool, Header)]
initHdrs of
        Maybe ([(Bool, Header)], (Bool, Header))
Nothing -> AppS
s { focus = DefaultHeadersToggle }
        Just ([(Bool, Header)]
_, (Bool
_, (CI ByteString
_, ByteString
lastValue))) -> AppS
s
          { focus = newFocus
          , headerEditor = Just . editorText newFocus (Just 1) $ decodeUtf8Lenient lastValue
          }
         where newFocus :: AppR
newFocus = CustomHeaderR -> AppR
ExistingCustomHeader MkCustomHeaderR { listIndex :: Int
listIndex = Int -> Int
forall a. Enum a => a -> a
pred Int
listIndex, column :: CustomHeaderColumn
column = CustomHeaderColumn
ValueEditor }
      CustomHeaderColumn
NameEditor -> AppS
s
        { focus = ExistingCustomHeader MkCustomHeaderR { listIndex, column = ActiveToggle }
        , headerEditor = Nothing
        , customHeaders =
            initHdrs ++ (flag, (maybe name (CaseInsensitive.mk . getEditorUtf8) (headerEditor s), value)) : tailHdrs
        }
      CustomHeaderColumn
ValueEditor -> AppS
s
        { focus = newFocus
        , headerEditor = Just . editorText newFocus (Just 1) . decodeUtf8Lenient $ original name
        , customHeaders =
            initHdrs ++ (flag, (name, maybe value getEditorUtf8 $ headerEditor s)) : tailHdrs
        }
       where
        newFocus :: AppR
newFocus = CustomHeaderR -> AppR
ExistingCustomHeader MkCustomHeaderR { Int
listIndex :: Int
listIndex :: Int
listIndex, column :: CustomHeaderColumn
column = CustomHeaderColumn
NameEditor }
    ([(Bool, Header)], [(Bool, Header)])
_ -> AppS
s { focus = DefaultHeadersToggle, headerEditor = Nothing } -- NB: invalid focus
  AppR
AddCustomHeader -> case [(Bool, Header)] -> Maybe ([(Bool, Header)], (Bool, Header))
forall a. [a] -> Maybe ([a], a)
unsnoc ([(Bool, Header)] -> Maybe ([(Bool, Header)], (Bool, Header)))
-> [(Bool, Header)] -> Maybe ([(Bool, Header)], (Bool, Header))
forall a b. (a -> b) -> a -> b
$ AppS -> [(Bool, Header)]
customHeaders AppS
s of
    Maybe ([(Bool, Header)], (Bool, Header))
Nothing -> AppS
s { focus = DefaultHeadersToggle }
    Just ([(Bool, Header)]
initHdrs, (Bool
_, (CI ByteString
_, ByteString
value))) -> AppS
s
      { focus = newFocus
      , headerEditor = Just $ editorText newFocus (Just 1) (decodeUtf8Lenient value)
      }
     where
      newFocus :: AppR
newFocus = CustomHeaderR -> AppR
ExistingCustomHeader MkCustomHeaderR { listIndex :: Int
listIndex = [(Bool, Header)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Header)]
initHdrs, column :: CustomHeaderColumn
column = CustomHeaderColumn
ValueEditor }
  AppR
ResponseBodyView -> AppS
s { focus = AddCustomHeader }
  AppR
MethodSelector -> AppS
s { focus = ResponseBodyView } -- NB: invalid focus


{-|
State update in response to event.

Widget names are all 'Text'.  No application specific events, so event type is 'Void'.

Global events handled here:
 * [Esc] (with any or no modifiers) and Ctrl+q (with any or no other modifiers) halts.
 * No application events are expected.
 * Mouse events are ignored.

Other Vty events are passed to 'handleEventLocal'.
-}
handleEvent :: BrickEvent AppR Void -> EventM AppR AppS ()
handleEvent :: BrickEvent AppR Void -> EventM AppR AppS ()
handleEvent (VtyEvent (EvKey Key
KEsc [Modifier]
_)) = EventM AppR AppS ()
forall n s. EventM n s ()
halt -- global: [ESC]: exit cleanly
handleEvent (VtyEvent e :: Event
e@(EvKey (KChar Char
'q') [Modifier]
mods)) = -- global Ctrl+q: exit cleanly
  if Modifier
MCtrl Modifier -> [Modifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods
   then EventM AppR AppS ()
forall n s. EventM n s ()
halt
   else Event -> EventM AppR AppS ()
handleEventLocal Event
e
handleEvent (VtyEvent Event
e) = Event -> EventM AppR AppS ()
handleEventLocal Event
e
handleEvent (AppEvent Void
bottom) = Void -> EventM AppR AppS ()
forall a. Void -> a
absurd Void
bottom -- can't happen
handleEvent MouseDown{} = () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignore
handleEvent MouseUp{} = () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignore

{-|
If the overlay is deing displayed, defer to 'handleEventOverlay'.  Otherwise, defer to
'handleEventMain'.  "Global" events should already have been handled in 'handleEvent'.
-}
handleEventLocal :: Event -> EventM AppR AppS ()
handleEventLocal :: Event -> EventM AppR AppS ()
handleEventLocal Event
e = do
  mos <- (AppS -> Maybe OverlayS) -> EventM AppR AppS (Maybe OverlayS)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppS -> Maybe OverlayS
overlayState
  -- switch to different behavior based on overlay
  case mos of
   Maybe OverlayS
Nothing -> Event -> EventM AppR AppS ()
handleEventMain Event
e
   Just OverlayS
os -> OverlayS -> Event -> EventM AppR AppS ()
handleEventOverlay OverlayS
os Event
e

{-|
Events for the main UI:
 * [Enter] causes the application to 'doRequest'
 * [Tab] causes 'moveFocusNext', [S+Tab] causes 'moveFocusPrev'.
 * [BackTab] casues 'moveFocusPrev', [S+BackTab] causes 'moveFocusNext'.
 * [Down] on the method text entry causes pop-up display; if focus is elsewhere it is ignored.
 * [Space] on the default headers editor toggles the setting.
 * If an editor is focused, other events update it.
-}
handleEventMain :: Event -> EventM AppR AppS ()
handleEventMain :: Event -> EventM AppR AppS ()
handleEventMain (EvKey Key
KEnter [Modifier]
_) = EventM AppR AppS AppS
forall s (m :: * -> *). MonadState s m => m s
get EventM AppR AppS AppS
-> (AppS -> EventM AppR AppS ()) -> EventM AppR AppS ()
forall a b.
EventM AppR AppS a
-> (a -> EventM AppR AppS b) -> EventM AppR AppS b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO AppS -> EventM AppR AppS ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO AppS -> EventM AppR AppS ())
-> (AppS -> IO AppS) -> AppS -> EventM AppR AppS ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppS -> IO AppS
doRequest
handleEventMain (EvKey (KChar Char
'\t') [Modifier]
mods) = -- change focus
  (AppS -> AppS) -> EventM AppR AppS ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppS -> AppS) -> EventM AppR AppS ())
-> (AppS -> AppS) -> EventM AppR AppS ()
forall a b. (a -> b) -> a -> b
$ if Modifier
MShift Modifier -> [Modifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods
    then AppS -> AppS
moveFocusPrev
    else AppS -> AppS
moveFocusNext
handleEventMain (EvKey Key
KBackTab [Modifier]
mods) = -- change focus
  (AppS -> AppS) -> EventM AppR AppS ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppS -> AppS) -> EventM AppR AppS ())
-> (AppS -> AppS) -> EventM AppR AppS ()
forall a b. (a -> b) -> a -> b
$ if Modifier
MShift Modifier -> [Modifier] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods
    then AppS -> AppS
moveFocusNext
    else AppS -> AppS
moveFocusPrev
handleEventMain Event
evt = do -- Depends on focus
  s <- EventM AppR AppS AppS
forall s (m :: * -> *). MonadState s m => m s
get
  case focus s of
     AppR
UrlEditor -> ALens' AppS (Editor [Char] AppR) -> Event -> EventM AppR AppS ()
handleEditorLEvent ALens' AppS (Editor [Char] AppR)
forall (f :: * -> *).
Functor f =>
(Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS
urlEditorL Event
evt
     AppR
MethodEditor -> Event -> EventM AppR AppS ()
handleMethodEditorEvent Event
evt
     AppR
DefaultHeadersToggle -> Event -> EventM AppR AppS ()
handleDefaultHeadersEditorEvent Event
evt
     ExistingCustomHeader CustomHeaderR
chResource -> CustomHeaderR -> Event -> EventM AppR AppS ()
handleCustomHeaderEvent CustomHeaderR
chResource Event
evt
     AppR
AddCustomHeader -> Event -> EventM AppR AppS ()
handleAddCustomHeaderEvent Event
evt
     AppR
ResponseBodyView -> Event -> EventM AppR AppS ()
handleResponseBodyViewportEvent Event
evt
     AppR
MethodSelector -> () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- NB: invalid focus / should be in handleEventOverlay

-- | Pass event into 'handleEditorEvent', when not handled more specifically.
handleEditorLEvent :: ALens' AppS (Editor String AppR) -> Event -> EventM AppR AppS ()
handleEditorLEvent :: ALens' AppS (Editor [Char] AppR) -> Event -> EventM AppR AppS ()
handleEditorLEvent ALens' AppS (Editor [Char] AppR)
editorL Event
evt = LensLike'
  (Zoomed (EventM AppR (Editor [Char] AppR)) ())
  AppS
  (Editor [Char] AppR)
-> EventM AppR (Editor [Char] AppR) () -> EventM AppR AppS ()
forall c.
LensLike'
  (Zoomed (EventM AppR (Editor [Char] AppR)) c)
  AppS
  (Editor [Char] AppR)
-> EventM AppR (Editor [Char] AppR) c -> EventM AppR AppS c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (ALens' AppS (Editor [Char] AppR)
-> forall (f :: * -> *).
   Functor f =>
   (Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' AppS (Editor [Char] AppR)
editorL) (BrickEvent AppR (ZonkAny 0) -> EventM AppR (Editor [Char] AppR) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (BrickEvent AppR (ZonkAny 0)
 -> EventM AppR (Editor [Char] AppR) ())
-> BrickEvent AppR (ZonkAny 0)
-> EventM AppR (Editor [Char] AppR) ()
forall a b. (a -> b) -> a -> b
$ Event -> BrickEvent AppR (ZonkAny 0)
forall n e. Event -> BrickEvent n e
VtyEvent Event
evt)

-- | Handle event when focus is on the method editor and will not change.
-- [Down] opens the method selector overlay.
-- Other events are passed to 'handleEditorLEvent'.
handleMethodEditorEvent :: Event -> EventM AppR AppS ()
handleMethodEditorEvent :: Event -> EventM AppR AppS ()
handleMethodEditorEvent (EvKey Key
KDown [Modifier]
_mods) = do
  s <- EventM AppR AppS AppS
forall s (m :: * -> *). MonadState s m => m s
get
  let
    enteredMethod = Getting [Char] AppS [Char] -> AppS -> [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Char] AppS [Char]
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> AppS -> f AppS
methodL AppS
s
    listContents = [[Char]] -> Vector [Char]
forall a. [a] -> Vector a
Vector.fromList ([[Char]] -> Vector [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Vector [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> Vector [Char]) -> [[Char]] -> Vector [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
enteredMethod [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
knownMethods
  mMethodEditorExtent <- lookupExtent MethodEditor
  for_ mMethodEditorExtent $ \Extent AppR
methodEditorExtent ->
    let
      initialListState :: GenericList AppR Vector [Char]
initialListState = ASetter
  (GenericList AppR Vector [Char])
  (GenericList AppR Vector [Char])
  (Maybe Int)
  (Maybe Int)
-> Maybe Int
-> GenericList AppR Vector [Char]
-> GenericList AppR Vector [Char]
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (GenericList AppR Vector [Char])
  (GenericList AppR Vector [Char])
  (Maybe Int)
  (Maybe Int)
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> GenericList n t e -> f (GenericList n t e)
listSelectedL (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) (GenericList AppR Vector [Char] -> GenericList AppR Vector [Char])
-> GenericList AppR Vector [Char] -> GenericList AppR Vector [Char]
forall a b. (a -> b) -> a -> b
$ AppR -> Vector [Char] -> Int -> GenericList AppR Vector [Char]
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BrickList.list AppR
MethodSelector Vector [Char]
listContents Int
1
      overlay :: OverlayS
overlay = OverlayS
        { methodList :: GenericList AppR Vector [Char]
methodList = GenericList AppR Vector [Char]
initialListState
        , methodEditorExtent :: Extent AppR
methodEditorExtent = Extent AppR
methodEditorExtent
        }
    in AppS -> EventM AppR AppS ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put AppS
s{overlayState = Just overlay}
handleMethodEditorEvent Event
evt = ALens' AppS (Editor [Char] AppR) -> Event -> EventM AppR AppS ()
handleEditorLEvent ALens' AppS (Editor [Char] AppR)
forall (f :: * -> *).
Functor f =>
(Editor [Char] AppR -> f (Editor [Char] AppR)) -> AppS -> f AppS
methodEditorL Event
evt

-- | Handle event when focus is on response body viewport and will not change.
-- * [Down] or 'j': line scroll down
-- * [Up] or 'k': line scroll up
-- * [Right] or 'l': column scroll right
-- * [Left] or 'h': column scroll left
-- * [PgDn]: page scroll down
-- * [PgUp]: page scroll up
-- * <ScrollUp>: 3 line scroll up
-- * <ScrollDown>: 3 line scroll down
handleResponseBodyViewportEvent :: Event -> EventM AppR AppS ()
handleResponseBodyViewportEvent :: Event -> EventM AppR AppS ()
handleResponseBodyViewportEvent Event
evt =
  case Event
evt of
    EvKey Key
k [Modifier]
_mods ->
      case Key
k of
        Key
KDown -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll AppR
vps Int
1
        KChar Char
'j' -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll AppR
vps Int
1
        Key
KUp -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll AppR
vps (-Int
1)
        KChar Char
'k' -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll AppR
vps (-Int
1)
        Key
KRight -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy ViewportScroll AppR
vps Int
1
        KChar Char
'l' -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy ViewportScroll AppR
vps Int
1
        Key
KLeft -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy ViewportScroll AppR
vps (-Int
1)
        KChar Char
'h' -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy ViewportScroll AppR
vps (-Int
1)
        Key
KPageDown -> ViewportScroll AppR -> forall s. Direction -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll AppR
vps Direction
Down
        Key
KPageUp -> ViewportScroll AppR -> forall s. Direction -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll AppR
vps Direction
Up
        Key
_ -> () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignored
    EvMouseDown Int
_x Int
_y Button
b [Modifier]
_mods ->
      case Button
b of
        Button
BScrollUp -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll AppR
vps (-Int
3)
        Button
BScrollDown -> ViewportScroll AppR -> forall s. Int -> EventM AppR s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll AppR
vps Int
3
        Button
_ -> () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignored
    Event
_ -> () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- ignored
 where
  vps :: ViewportScroll AppR
vps = AppR -> ViewportScroll AppR
forall n. n -> ViewportScroll n
viewportScroll AppR
ResponseBodyView

-- | Handle event when focus in on default headers editor and will not change.
handleDefaultHeadersEditorEvent :: Event -> EventM AppR AppS ()
handleDefaultHeadersEditorEvent :: Event -> EventM AppR AppS ()
handleDefaultHeadersEditorEvent (EvKey (KChar Char
' ') [Modifier]
_) = (Bool -> Identity Bool) -> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppS -> f AppS
useDefaultHeadersL ((Bool -> Identity Bool) -> AppS -> Identity AppS)
-> (Bool -> Bool) -> EventM AppR AppS ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
handleDefaultHeadersEditorEvent Event
_ = () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | If in the active column, SP toggles.  Otherwise, pass to the active headerEditor (which _should_ not be Nothing).
--
-- FUTURE: Allow KUp and KDown to move the focus.
--
-- TBD: How to delete (not just deactivate) a custom header?
handleCustomHeaderEvent :: CustomHeaderR -> Event -> EventM AppR AppS ()
handleCustomHeaderEvent :: CustomHeaderR -> Event -> EventM AppR AppS ()
handleCustomHeaderEvent MkCustomHeaderR { Int
listIndex :: CustomHeaderR -> Int
listIndex :: Int
listIndex, column :: CustomHeaderR -> CustomHeaderColumn
column = CustomHeaderColumn
ActiveToggle } (EvKey (KChar Char
' ') [Modifier]
_) =
  ([(Bool, Header)] -> Identity [(Bool, Header)])
-> AppS -> Identity AppS
forall (f :: * -> *).
Functor f =>
([(Bool, Header)] -> f [(Bool, Header)]) -> AppS -> f AppS
customHeadersL (([(Bool, Header)] -> Identity [(Bool, Header)])
 -> AppS -> Identity AppS)
-> ([(Bool, Header)] -> [(Bool, Header)]) -> EventM AppR AppS ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= [(Bool, Header)] -> [(Bool, Header)]
toggleHeader
 where
  toggleHeader :: [(Bool, Header)] -> [(Bool, Header)]
toggleHeader [(Bool, Header)]
oldHeaders = case Int -> [(Bool, Header)] -> ([(Bool, Header)], [(Bool, Header)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
listIndex [(Bool, Header)]
oldHeaders of
    ([(Bool, Header)]
initHdrs, (Bool
flag, Header
hdr) : [(Bool, Header)]
tailHdrs) -> [(Bool, Header)]
initHdrs [(Bool, Header)] -> [(Bool, Header)] -> [(Bool, Header)]
forall a. [a] -> [a] -> [a]
++ (Bool -> Bool
not Bool
flag, Header
hdr) (Bool, Header) -> [(Bool, Header)] -> [(Bool, Header)]
forall a. a -> [a] -> [a]
: [(Bool, Header)]
tailHdrs
    ([(Bool, Header)], [(Bool, Header)])
_ -> [(Bool, Header)]
oldHeaders -- Invalid Index
handleCustomHeaderEvent CustomHeaderR
_ Event
evt = LensLike'
  (Zoomed (EventM AppR (Editor Text AppR)) ())
  AppS
  (Editor Text AppR)
-> EventM AppR (Editor Text AppR) () -> EventM AppR AppS ()
forall c.
LensLike'
  (Zoomed (EventM AppR (Editor Text AppR)) c) AppS (Editor Text AppR)
-> EventM AppR (Editor Text AppR) c -> EventM AppR AppS c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((Maybe (Editor Text AppR)
 -> Focusing
      (StateT (EventState AppR) IO) () (Maybe (Editor Text AppR)))
-> AppS -> Focusing (StateT (EventState AppR) IO) () AppS
forall (f :: * -> *).
Functor f =>
(Maybe (Editor Text AppR) -> f (Maybe (Editor Text AppR)))
-> AppS -> f AppS
headerEditorL ((Maybe (Editor Text AppR)
  -> Focusing
       (StateT (EventState AppR) IO) () (Maybe (Editor Text AppR)))
 -> AppS -> Focusing (StateT (EventState AppR) IO) () AppS)
-> ((Editor Text AppR
     -> Focusing (StateT (EventState AppR) IO) () (Editor Text AppR))
    -> Maybe (Editor Text AppR)
    -> Focusing
         (StateT (EventState AppR) IO) () (Maybe (Editor Text AppR)))
-> (Editor Text AppR
    -> Focusing (StateT (EventState AppR) IO) () (Editor Text AppR))
-> AppS
-> Focusing (StateT (EventState AppR) IO) () AppS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text AppR
 -> Focusing (StateT (EventState AppR) IO) () (Editor Text AppR))
-> Maybe (Editor Text AppR)
-> Focusing
     (StateT (EventState AppR) IO) () (Maybe (Editor Text AppR))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (EventM AppR (Editor Text AppR) () -> EventM AppR AppS ())
-> (BrickEvent AppR (ZonkAny 1)
    -> EventM AppR (Editor Text AppR) ())
-> BrickEvent AppR (ZonkAny 1)
-> EventM AppR AppS ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BrickEvent AppR (ZonkAny 1) -> EventM AppR (Editor Text AppR) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (BrickEvent AppR (ZonkAny 1) -> EventM AppR AppS ())
-> BrickEvent AppR (ZonkAny 1) -> EventM AppR AppS ()
forall a b. (a -> b) -> a -> b
$ Event -> BrickEvent AppR (ZonkAny 1)
forall n e. Event -> BrickEvent n e
VtyEvent Event
evt

-- | SP creates a new header.
handleAddCustomHeaderEvent :: Event -> EventM AppR AppS ()
handleAddCustomHeaderEvent :: Event -> EventM AppR AppS ()
handleAddCustomHeaderEvent (EvKey (KChar Char
' ') [Modifier]
_) = (AppS -> AppS) -> EventM AppR AppS ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppS -> AppS
addNewCustomHeader
 where
  addNewCustomHeader :: AppS -> AppS
addNewCustomHeader AppS
oldState = AppS
oldState
    { customHeaders = oldCustomHeaders ++ [(True, (CaseInsensitive.mk newName, ByteString.empty))]
    , focus = newFocus
    , headerEditor = Just . editorText newFocus (Just 1) $ decodeUtf8Lenient newName
    }
   where
    oldCustomHeaders :: [(Bool, Header)]
oldCustomHeaders = AppS -> [(Bool, Header)]
customHeaders AppS
oldState
    newName :: ByteString
newName = ByteString
ByteString.empty
    newFocus :: AppR
newFocus = CustomHeaderR -> AppR
ExistingCustomHeader MkCustomHeaderR { listIndex :: Int
listIndex = [(Bool, Header)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Header)]
oldCustomHeaders, column :: CustomHeaderColumn
column = CustomHeaderColumn
NameEditor }
handleAddCustomHeaderEvent Event
_ = () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Retrieve extent emitted during last draw and update overlay state.
updateExtent :: EventM AppR OverlayS ()
updateExtent :: EventM AppR OverlayS ()
updateExtent = do
  mExtent <- AppR -> EventM AppR OverlayS (Maybe (Extent AppR))
forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent AppR
MethodEditor
  for_ mExtent $ \Extent AppR
extent ->
   (OverlayS -> OverlayS) -> EventM AppR OverlayS ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((OverlayS -> OverlayS) -> EventM AppR OverlayS ())
-> (OverlayS -> OverlayS) -> EventM AppR OverlayS ()
forall a b. (a -> b) -> a -> b
$ ASetter OverlayS OverlayS (Extent AppR) (Extent AppR)
-> Extent AppR -> OverlayS -> OverlayS
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter OverlayS OverlayS (Extent AppR) (Extent AppR)
forall (f :: * -> *).
Functor f =>
(Extent AppR -> f (Extent AppR)) -> OverlayS -> f OverlayS
methodEditorExtentL Extent AppR
extent

{-|
Events for the overlay:
 * [Enter] closes the overlay taking the selected method and updating the application state.
 * Other events are sent to the method selection list.

All code paths should 'updateExtent', in case the pop-up needs to move.
-}
handleEventOverlay :: OverlayS -> Event -> EventM AppR AppS ()
handleEventOverlay :: OverlayS -> Event -> EventM AppR AppS ()
handleEventOverlay OverlayS
currentOverlay (EvKey Key
KEnter [Modifier]
_) = do -- pick selected method, remove popup
  mSelectedMethod <- ((OverlayS, Maybe [Char]) -> Maybe [Char])
-> EventM AppR AppS (OverlayS, Maybe [Char])
-> EventM AppR AppS (Maybe [Char])
forall a b. (a -> b) -> EventM AppR AppS a -> EventM AppR AppS b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OverlayS, Maybe [Char]) -> Maybe [Char]
forall a b. (a, b) -> b
snd (EventM AppR AppS (OverlayS, Maybe [Char])
 -> EventM AppR AppS (Maybe [Char]))
-> (EventM AppR OverlayS (Maybe [Char])
    -> EventM AppR AppS (OverlayS, Maybe [Char]))
-> EventM AppR OverlayS (Maybe [Char])
-> EventM AppR AppS (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayS
-> EventM AppR OverlayS (Maybe [Char])
-> EventM AppR AppS (OverlayS, Maybe [Char])
forall a n b s. a -> EventM n a b -> EventM n s (a, b)
nestEventM OverlayS
currentOverlay (EventM AppR OverlayS (Maybe [Char])
 -> EventM AppR AppS (Maybe [Char]))
-> EventM AppR OverlayS (Maybe [Char])
-> EventM AppR AppS (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    EventM AppR OverlayS ()
updateExtent
    (OverlayS -> Maybe [Char]) -> EventM AppR OverlayS (Maybe [Char])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((OverlayS -> Maybe [Char]) -> EventM AppR OverlayS (Maybe [Char]))
-> (OverlayS -> Maybe [Char])
-> EventM AppR OverlayS (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ ((Int, [Char]) -> [Char]) -> Maybe (Int, [Char]) -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd (Maybe (Int, [Char]) -> Maybe [Char])
-> (OverlayS -> Maybe (Int, [Char])) -> OverlayS -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericList AppR Vector [Char] -> Maybe (Int, [Char])
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (GenericList AppR Vector [Char] -> Maybe (Int, [Char]))
-> (OverlayS -> GenericList AppR Vector [Char])
-> OverlayS
-> Maybe (Int, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlayS -> GenericList AppR Vector [Char]
methodList
  for_ mSelectedMethod $ \[Char]
method ->
    (AppS -> AppS) -> EventM AppR AppS ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppS -> AppS) -> EventM AppR AppS ())
-> (AppS -> AppS) -> EventM AppR AppS ()
forall a b. (a -> b) -> a -> b
$ ASetter AppS AppS [Char] [Char] -> [Char] -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter AppS AppS [Char] [Char]
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> AppS -> f AppS
methodL [Char]
method (AppS -> AppS) -> (AppS -> AppS) -> AppS -> AppS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter AppS AppS (Maybe OverlayS) (Maybe OverlayS)
-> Maybe OverlayS -> AppS -> AppS
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter AppS AppS (Maybe OverlayS) (Maybe OverlayS)
forall (f :: * -> *).
Functor f =>
(Maybe OverlayS -> f (Maybe OverlayS)) -> AppS -> f AppS
overlayStateL Maybe OverlayS
forall a. Maybe a
Nothing
handleEventOverlay OverlayS
_currentOverlay Event
e = LensLike' (Zoomed (EventM AppR OverlayS) ()) AppS OverlayS
-> EventM AppR OverlayS () -> EventM AppR AppS ()
forall c.
LensLike' (Zoomed (EventM AppR OverlayS) c) AppS OverlayS
-> EventM AppR OverlayS c -> EventM AppR AppS c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((Maybe OverlayS
 -> Focusing (StateT (EventState AppR) IO) () (Maybe OverlayS))
-> AppS -> Focusing (StateT (EventState AppR) IO) () AppS
forall (f :: * -> *).
Functor f =>
(Maybe OverlayS -> f (Maybe OverlayS)) -> AppS -> f AppS
overlayStateL ((Maybe OverlayS
  -> Focusing (StateT (EventState AppR) IO) () (Maybe OverlayS))
 -> AppS -> Focusing (StateT (EventState AppR) IO) () AppS)
-> ((OverlayS
     -> Focusing (StateT (EventState AppR) IO) () OverlayS)
    -> Maybe OverlayS
    -> Focusing (StateT (EventState AppR) IO) () (Maybe OverlayS))
-> (OverlayS -> Focusing (StateT (EventState AppR) IO) () OverlayS)
-> AppS
-> Focusing (StateT (EventState AppR) IO) () AppS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OverlayS -> Focusing (StateT (EventState AppR) IO) () OverlayS)
-> Maybe OverlayS
-> Focusing (StateT (EventState AppR) IO) () (Maybe OverlayS)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (EventM AppR OverlayS () -> EventM AppR AppS ())
-> EventM AppR OverlayS () -> EventM AppR AppS ()
forall a b. (a -> b) -> a -> b
$ do -- defer to list
    EventM AppR OverlayS ()
updateExtent
    LensLike'
  (Zoomed (EventM AppR (GenericList AppR Vector [Char])) ())
  OverlayS
  (GenericList AppR Vector [Char])
-> EventM AppR (GenericList AppR Vector [Char]) ()
-> EventM AppR OverlayS ()
forall c.
LensLike'
  (Zoomed (EventM AppR (GenericList AppR Vector [Char])) c)
  OverlayS
  (GenericList AppR Vector [Char])
-> EventM AppR (GenericList AppR Vector [Char]) c
-> EventM AppR OverlayS c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList AppR Vector [Char]
 -> Focusing
      (StateT (EventState AppR) IO) () (GenericList AppR Vector [Char]))
-> OverlayS -> Focusing (StateT (EventState AppR) IO) () OverlayS
LensLike'
  (Zoomed (EventM AppR (GenericList AppR Vector [Char])) ())
  OverlayS
  (GenericList AppR Vector [Char])
forall (f :: * -> *).
Functor f =>
(GenericList AppR Vector [Char]
 -> f (GenericList AppR Vector [Char]))
-> OverlayS -> f OverlayS
methodListL (Event -> EventM AppR (GenericList AppR Vector [Char]) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)

-- | Extract the concatenated text content of a 'Brick.Widgets.Edit.Editor' as a UTF-8 'ByteString'.
getEditorUtf8 :: Editor Text n -> ByteString
getEditorUtf8 :: forall n. Editor Text n -> ByteString
getEditorUtf8 = Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (Editor Text n -> Text) -> Editor Text n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> (Editor Text n -> [Text]) -> Editor Text n -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor Text n -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents

{-|
Construct and issue a wreq request from the application state, handle request failures that are
raised as exceptions in IO, updating the application state ('lastResponse') either from the
response or the execption.
-}
doRequest :: AppS -> IO AppS
doRequest :: AppS -> IO AppS
doRequest AppS
s = do
  result <- IO Image -> IO (Either SomeException Image)
forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
m a -> m (Either SomeException a)
tryAnyDeep (IO Image -> IO (Either SomeException Image))
-> IO Image -> IO (Either SomeException Image)
forall a b. (a -> b) -> a -> b
$ do
    let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ((Either ManagerSettings Manager
 -> Identity (Either ManagerSettings Manager))
-> Options -> Identity Options
Lens' Options (Either ManagerSettings Manager)
W.manager ((Either ManagerSettings Manager
  -> Identity (Either ManagerSettings Manager))
 -> Options -> Identity Options)
-> Either ManagerSettings Manager -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Manager -> Either ManagerSettings Manager
forall a b. b -> Either a b
Right (AppS -> Manager
connManager AppS
s))
    response <- Options -> [Char] -> IO (Response ByteString)
httpRequest Options
opts ([Char] -> IO (Response ByteString))
-> (Editor [Char] AppR -> [Char])
-> Editor [Char] AppR
-> IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> (Editor [Char] AppR -> [[Char]]) -> Editor [Char] AppR -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper [Char] -> [[Char]]
forall a. Monoid a => TextZipper a -> [a]
getText (TextZipper [Char] -> [[Char]])
-> (Editor [Char] AppR -> TextZipper [Char])
-> Editor [Char] AppR
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (TextZipper [Char]) (Editor [Char] AppR) (TextZipper [Char])
-> Editor [Char] AppR -> TextZipper [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TextZipper [Char]) (Editor [Char] AppR) (TextZipper [Char])
forall t1 n t2 (f :: * -> *).
Functor f =>
(TextZipper t1 -> f (TextZipper t2))
-> Editor t1 n -> f (Editor t2 n)
editContentsL (Editor [Char] AppR -> IO (Response ByteString))
-> Editor [Char] AppR -> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ AppS -> Editor [Char] AppR
urlEditor AppS
s
    pure $ syntaxHighlightResponse (pure $ view responseBody response) (responseContentType response)
  pure s{ lastResponse = either exResponse id result }
 where
  justSndIfFst :: (Bool, a) -> Maybe a
justSndIfFst (Bool
active, a
value) = if Bool
active then a -> Maybe a
forall a. a -> Maybe a
Just a
value else Maybe a
forall a. Maybe a
Nothing
  updateHeaders :: AppS -> [Header] -> [Header]
updateHeaders AppS{Bool
[(Bool, Header)]
Maybe ByteString
Maybe (Editor Text AppR)
Maybe OverlayS
Editor [Char] AppR
Manager
Image
AppR
focus :: AppS -> AppR
methodEditor :: AppS -> Editor [Char] AppR
overlayState :: AppS -> Maybe OverlayS
urlEditor :: AppS -> Editor [Char] AppR
useDefaultHeaders :: AppS -> Bool
customHeaders :: AppS -> [(Bool, Header)]
headerEditor :: AppS -> Maybe (Editor Text AppR)
connManager :: AppS -> Manager
payload :: AppS -> Maybe ByteString
lastResponse :: AppS -> Image
focus :: AppR
methodEditor :: Editor [Char] AppR
overlayState :: Maybe OverlayS
urlEditor :: Editor [Char] AppR
lastResponse :: Image
useDefaultHeaders :: Bool
customHeaders :: [(Bool, Header)]
headerEditor :: Maybe (Editor Text AppR)
payload :: Maybe ByteString
connManager :: Manager
..} = if Bool
useDefaultHeaders then ([Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
activeCustomHeaders) else [Header] -> [Header] -> [Header]
forall a b. a -> b -> a
const [Header]
activeCustomHeaders
   where
    activeCustomHeaders :: [Header]
activeCustomHeaders = case AppR
focus of
      ExistingCustomHeader MkCustomHeaderR{Int
CustomHeaderColumn
column :: CustomHeaderR -> CustomHeaderColumn
listIndex :: CustomHeaderR -> Int
listIndex :: Int
column :: CustomHeaderColumn
..} -> [Maybe Header] -> [Header]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Header] -> [Header]) -> [Maybe Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ (Int -> (Bool, Header) -> Maybe Header)
-> [Int] -> [(Bool, Header)] -> [Maybe Header]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Bool, Header) -> Maybe Header
focusedOrSaved [Int
0..] [(Bool, Header)]
customHeaders
       where
        focusedOrSaved :: Int -> (Bool, Header) -> Maybe Header
focusedOrSaved Int
_i (Bool
False, Header
_) = Maybe Header
forall a. Maybe a
Nothing
        focusedOrSaved Int
i (Bool
True, Header
hdr) = if Int
listIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then Header -> Maybe Header
forall a. a -> Maybe a
Just (Header -> Maybe Header) -> Header -> Maybe Header
forall a b. (a -> b) -> a -> b
$ Header -> Header
focusByColumn Header
hdr else Header -> Maybe Header
forall a. a -> Maybe a
Just Header
hdr
        focusByColumn :: Header -> Header
focusByColumn Header
hdr = case CustomHeaderColumn
column of
          CustomHeaderColumn
ActiveToggle -> Header
hdr
          CustomHeaderColumn
NameEditor -> (CI ByteString
-> (Editor Text AppR -> CI ByteString)
-> Maybe (Editor Text AppR)
-> CI ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Header -> CI ByteString
forall a b. (a, b) -> a
fst Header
hdr) (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CaseInsensitive.mk (ByteString -> CI ByteString)
-> (Editor Text AppR -> ByteString)
-> Editor Text AppR
-> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor Text AppR -> ByteString
forall n. Editor Text n -> ByteString
getEditorUtf8) Maybe (Editor Text AppR)
headerEditor, Header -> ByteString
forall a b. (a, b) -> b
snd Header
hdr)
          CustomHeaderColumn
ValueEditor -> (Header -> CI ByteString
forall a b. (a, b) -> a
fst Header
hdr, ByteString
-> (Editor Text AppR -> ByteString)
-> Maybe (Editor Text AppR)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Header -> ByteString
forall a b. (a, b) -> b
snd Header
hdr) Editor Text AppR -> ByteString
forall n. Editor Text n -> ByteString
getEditorUtf8 Maybe (Editor Text AppR)
headerEditor)
      AppR
_ -> ((Bool, Header) -> Maybe Header) -> [(Bool, Header)] -> [Header]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool, Header) -> Maybe Header
forall {a}. (Bool, a) -> Maybe a
justSndIfFst [(Bool, Header)]
customHeaders
  httpMethod :: AppS -> [Char]
httpMethod AppS{Bool
[(Bool, Header)]
Maybe ByteString
Maybe (Editor Text AppR)
Maybe OverlayS
Editor [Char] AppR
Manager
Image
AppR
focus :: AppS -> AppR
methodEditor :: AppS -> Editor [Char] AppR
overlayState :: AppS -> Maybe OverlayS
urlEditor :: AppS -> Editor [Char] AppR
useDefaultHeaders :: AppS -> Bool
customHeaders :: AppS -> [(Bool, Header)]
headerEditor :: AppS -> Maybe (Editor Text AppR)
connManager :: AppS -> Manager
payload :: AppS -> Maybe ByteString
lastResponse :: AppS -> Image
focus :: AppR
methodEditor :: Editor [Char] AppR
overlayState :: Maybe OverlayS
urlEditor :: Editor [Char] AppR
lastResponse :: Image
useDefaultHeaders :: Bool
customHeaders :: [(Bool, Header)]
headerEditor :: Maybe (Editor Text AppR)
payload :: Maybe ByteString
connManager :: Manager
..} = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> (TextZipper [Char] -> [[Char]]) -> TextZipper [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper [Char] -> [[Char]]
forall a. Monoid a => TextZipper a -> [a]
getText (TextZipper [Char] -> [Char]) -> TextZipper [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Getting
  (TextZipper [Char]) (Editor [Char] AppR) (TextZipper [Char])
-> Editor [Char] AppR -> TextZipper [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TextZipper [Char]) (Editor [Char] AppR) (TextZipper [Char])
forall t1 n t2 (f :: * -> *).
Functor f =>
(TextZipper t1 -> f (TextZipper t2))
-> Editor t1 n -> f (Editor t2 n)
editContentsL Editor [Char] AppR
methodEditor
  httpOptions :: Options -> Options
httpOptions = ([Header] -> Identity [Header]) -> Options -> Identity Options
Lens' Options [Header]
headers (([Header] -> Identity [Header]) -> Options -> Identity Options)
-> ([Header] -> [Header]) -> Options -> Options
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AppS -> [Header] -> [Header]
updateHeaders AppS
s
  httpRequest :: Options -> [Char] -> IO (Response ByteString)
httpRequest Options
opts =
    case AppS -> Maybe ByteString
payload AppS
s of
     Maybe ByteString
Nothing -> [Char] -> Options -> [Char] -> IO (Response ByteString)
customMethodWith (AppS -> [Char]
httpMethod AppS
s) (Options -> Options
httpOptions Options
opts)
     Just ByteString
lbs -> \[Char]
url -> [Char]
-> Options -> [Char] -> ByteString -> IO (Response ByteString)
forall a.
Postable a =>
[Char] -> Options -> [Char] -> a -> IO (Response ByteString)
customPayloadMethodWith (AppS -> [Char]
httpMethod AppS
s) (Options -> Options
httpOptions Options
opts) [Char]
url ByteString
lbs
  exResponse :: a -> Image
exResponse a
ex = Attr -> Text -> Image
VI.text (MaybeDefault Style
-> MaybeDefault Color
-> MaybeDefault Color
-> MaybeDefault Text
-> Attr
VA.Attr MaybeDefault Style
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Text
forall v. MaybeDefault v
VA.Default) (Text -> Image) -> Text -> Image
forall a b. (a -> b) -> a -> b
$ Text
"[Exception: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
LText.pack (a -> [Char]
forall a. Show a => a -> [Char]
show a
ex) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  responseContentType :: Response body -> Maybe ByteString
responseContentType Response body
resp = (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
LBS.fromStrict (Maybe ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Response body
resp Response body
-> Getting (First ByteString) (Response body) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? CI ByteString -> Traversal' (Response body) ByteString
forall body. CI ByteString -> Traversal' (Response body) ByteString
responseHeader CI ByteString
"Content-Type"

{-|
Render an HTTP response body (or an empty-body signal) as a Vty 'Image' with optional
syntax highlighting based on the @Content-Type@ header.

The incoming payload 'ByteString' is passed through 'cleanPayload' before rendering to
strip characters that are incompatible with Vty's text rendering (e.g. @ESC@, vertical
tab).  Newlines are preserved — they are the line delimiters used by Vty's @vertCat@.

* If the body is 'Nothing', a placeholder @"-- No response body --"@ line is returned.
* If no @Content-Type@ is present, 'noSyntaxFound' is used.
* Otherwise the MIME type is looked up in the default extension map and the first matching
  skylighting 'Syntax' is used by 'highlighted'.
-}
syntaxHighlightResponse :: Maybe LBS.ByteString -> Maybe LBS.ByteString -> Image
syntaxHighlightResponse :: Maybe ByteString -> Maybe ByteString -> Image
syntaxHighlightResponse Maybe ByteString
Nothing Maybe ByteString
_ = Attr -> Text -> Image
VI.text (MaybeDefault Style
-> MaybeDefault Color
-> MaybeDefault Color
-> MaybeDefault Text
-> Attr
VA.Attr MaybeDefault Style
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Text
forall v. MaybeDefault v
VA.Default) Text
"-- No response body --\n"
syntaxHighlightResponse (Just ByteString
payload) Maybe ByteString
Nothing = Text -> Image
noSyntaxFound (Text -> Image) -> Text -> Image
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
cleanPayload ByteString
payload
syntaxHighlightResponse (Just ByteString
payload) (Just ByteString
contentType) = case [Syntax]
syntaxFromExtension of
  (Syntax
syn:[Syntax]
_) -> Syntax -> Text -> Image
highlighted Syntax
syn (Text -> Image) -> Text -> Image
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
cleanPayload ByteString
payload
  [] -> Text -> Image
noSyntaxFound (Text -> Image) -> Text -> Image
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
cleanPayload ByteString
payload
 where
  syntaxFromExtension :: [Syntax]
syntaxFromExtension = (Text -> Maybe Syntax) -> [Text] -> [Syntax]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> SyntaxMap -> Maybe Syntax
`lookupSyntax` SyntaxMap
defaultSyntaxMap) [Text]
contentTypeToExtensionList
  contentTypeToExtensionList :: [Text]
contentTypeToExtensionList = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Map ByteString [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
mimeType Map ByteString [Text]
defaultExtensionMap
  mimeType :: ByteString
mimeType = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
lbsToText ByteString
contentType


{-|
Sanitise a lazy 'ByteString' response body for display in Vty.

Decodes to 'Text' with lenient UTF-8 decoding, then:

* Strips @ESC@ (@\\ESC@) and vertical-tab (@\\v@) characters which would corrupt Vty output.
* Expands tab characters to four spaces.
-}
cleanPayload :: LBS.ByteString -> Text
cleanPayload :: ByteString -> Text
cleanPayload = Text -> Text
expandTabs (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
cleanText
  where
    cleanText :: ByteString -> Text
cleanText = (Char -> Bool) -> Text -> Text
Text.filter (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\ESC', Char
'\v']) (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
lbsToText
    expandTabs :: Text -> Text
expandTabs = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"\t" Text
"    "

{-|
Tokenise and render 'Text' using skylighting's 'pygments' theme for the given 'Syntax'.

Falls back to a plain error message image if tokenisation fails.
-}
highlighted :: Syntax -> Text -> Image
highlighted :: Syntax -> Text -> Image
highlighted Syntax
s Text
t = case TokenizerConfig -> Syntax -> Text -> Either [Char] [SourceLine]
tokenize (SyntaxMap -> Bool -> TokenizerConfig
TokenizerConfig SyntaxMap
defaultSyntaxMap Bool
False) Syntax
s Text
t of
  Left [Char]
err -> (Text -> Image -> Image) -> Image -> [Text] -> Image
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Image -> Image -> Image
(<->) (Image -> Image -> Image)
-> (Text -> Image) -> Text -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image
VI.text (MaybeDefault Style
-> MaybeDefault Color
-> MaybeDefault Color
-> MaybeDefault Text
-> Attr
VA.Attr MaybeDefault Style
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Text
forall v. MaybeDefault v
VA.Default))
    Image
VI.emptyImage
    [Text
"-- Syntax highlighting error: ", [Char] -> Text
LText.pack [Char]
err, Text
" --" , Text -> Text
LText.fromStrict Text
t]
  Right [SourceLine]
sourceLines -> FormatOptions -> Style -> [SourceLine] -> Image
formatVty FormatOptions
defaultFormatOpts Style
pygments [SourceLine]
sourceLines

{-|
Render pre-cleaned 'Text' as a plain (unsyntaxed) Vty 'Image', one line per row.

Used when no matching 'Skylighting.Types.Syntax' can be found for the response content type.
-}
noSyntaxFound :: Text -> Image
noSyntaxFound :: Text -> Image
noSyntaxFound Text
payload = (Text -> Image -> Image) -> Image -> [Text] -> Image
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (Image -> Image -> Image
(<->) (Image -> Image -> Image)
-> (Text -> Image) -> Text -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image
VI.text (MaybeDefault Style
-> MaybeDefault Color
-> MaybeDefault Color
-> MaybeDefault Text
-> Attr
VA.Attr MaybeDefault Style
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Color
forall v. MaybeDefault v
VA.Default MaybeDefault Text
forall v. MaybeDefault v
VA.Default))
    Image
VI.emptyImage
    (Text
"--Uknown Body Type --" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
LText.fromStrict (Text -> [Text]
Text.lines Text
payload))

-- | Decode a lazy 'LBS.ByteString' to strict 'Text' using lenient UTF-8 decoding.
lbsToText :: LBS.ByteString -> Text
lbsToText :: ByteString -> Text
lbsToText = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict