diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +# v7.2.0 (2026-04-29) + +## ✨ New Features +- [`0cb27a4`](https://gitlab.com/krakrjak/restman/-/commit/0cb27a4) ✨ Editable and Toggleable Custom Headers (Issues: [`#16`](https://gitlab.com/16/restman/-/issues/#16) [`16`](16)) + +## 🐛 Bug Fixes + +## 🏗️ Architecture Changes +### ⬆️ Dependency Changes +- [`594534c`](https://gitlab.com/krakrjak/restman/-/commit/594534c) ⬆️ Update dependency semantic-release to v25 +- [`248784c`](https://gitlab.com/krakrjak/restman/-/commit/248784c) ⬆️ Stackage LTS 24.38 +- [`2d1bc13`](https://gitlab.com/krakrjak/restman/-/commit/2d1bc13) ⬆️ Semantic Release 25.0.3 (bunfig.toml fixes) + # v7.1.2 (2026-01-14) ## ✨ New Features diff --git a/restman.cabal b/restman.cabal --- a/restman.cabal +++ b/restman.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: restman -version: 0.7.1.2 +version: 0.7.2.0 license: BSD2 license-file: LICENSE copyright: Zac Slade or Boyd Stephen Smith Jr, 2024 @@ -33,6 +33,7 @@ hs-source-dirs: src other-modules: Paths_restman default-language: GHC2024 + ghc-options: -Wall build-depends: ansi-terminal-types >=1.1.3 && <1.2, base >=4.7 && <5, @@ -44,9 +45,9 @@ http-client >=0.7.19 && <0.8, http-client-tls >=0.3.6.4 && <0.4, http-types >=0.12.4 && <0.13, - lens >=5.3.5 && <5.4, + lens >=5.3.6 && <5.4, microlens-mtl >=0.2.1.0 && <0.3, - mime-types >=0.1.2.0 && <0.2, + mime-types >=0.1.2.2 && <0.2, mtl >=2.3.1 && <2.4, skylighting >=0.14.7 && <0.15, text >=2.1.3 && <2.2, @@ -54,7 +55,7 @@ unliftio >=0.2.25.1 && <0.3, vector >=0.13.2.0 && <0.14, vty >=6.4 && <6.5, - wreq >=0.5.4.3 && <0.6 + wreq >=0.5.4.4 && <0.6 executable restman main-is: Main.hs @@ -76,7 +77,7 @@ restman, text >=2.1.3 && <2.2, utf8-string >=1.0.2 && <1.1, - wreq >=0.5.4.3 && <0.6 + wreq >=0.5.4.4 && <0.6 test-suite restman-test type: exitcode-stdio-1.0 diff --git a/src/Lib.hs b/src/Lib.hs --- a/src/Lib.hs +++ b/src/Lib.hs @@ -12,34 +12,19 @@ module Lib ( chooseCursor , draw - , focusRing , growWith , handleEvent , doRequest - , defaultHeadersEditorName - , responseBodyViewportName ) where -- base +import Data.Bits (xor) import Data.Foldable (for_) -import Data.List (nub) -import Data.Maybe (fromMaybe, mapMaybe) +import Data.List (nub, unsnoc) +import Data.Maybe (catMaybes, fromMaybe, mapMaybe) import Data.Void (Void, absurd) --- bytestring -import Data.ByteString.Lazy (toStrict) -import qualified Data.ByteString.Lazy as LBS - -- brick -import Brick.Focus - ( FocusRing - , focusGetCurrent - , focusNext - , focusPrev - , focusRing - , focusRingCursor - , withFocusRing - ) import Brick.Main ( hScrollBy , halt @@ -57,21 +42,26 @@ , EventM , Extent , HScrollBarOrientation(OnBottom) + , Result(image) + , Size(Fixed) , VScrollBarOrientation(OnRight) , ViewportType(Both) - , Widget(render) + , Widget(Widget, render) + , attrL + , emptyResult , extentSize , extentUpperLeft + , getContext , imageL , nestEventM ) import Brick.Widgets.Border (borderWithLabel) -import qualified Brick.Widgets.Border.Style as BS +import Brick.Widgets.Border.Style (unicodeBold) import Brick.Widgets.Core ( fill - , getName , hBox , hLimit + , modifyDefAttr , padLeftRight , raw , reportExtent @@ -88,7 +78,13 @@ , withVScrollBars ) import Brick.Widgets.Edit - (Editor, editContentsL, handleEditorEvent, renderEditor) + ( Editor + , editContentsL + , editorText + , getEditContents + , handleEditorEvent + , renderEditor + ) import Brick.Widgets.List ( List , handleListEvent @@ -101,15 +97,22 @@ 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, (%=), (%~), (&), (.~), (^?)) + (ALens', _Just, cloneLens, set, view, (%=), (%~), (&), (.~), (^.), (^?)) -- microlens-mtl import Lens.Micro.Mtl (zoom) @@ -134,7 +137,7 @@ -- text import Data.Text (Text) import qualified Data.Text as Text -import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +import Data.Text.Encoding (decodeUtf8Lenient, decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as LText @@ -151,14 +154,14 @@ import qualified Network.Wreq as W -- vty -import Graphics.Vty.Attributes (Attr, currentAttr, reverseVideo, withStyle) +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 - , text' , utf8Bytestring' , vertCat , (<->) @@ -184,10 +187,8 @@ , responseBody , responseHeader ) - import Skylighting.Format.Vty (formatVty) import Types - (AppS(..), OverlayS(..), RangeInAlign(..), VertAlign, WideAlign, left, top) -- | Second argument must be positive. splitExtraSpace :: RangeInAlign -> Int -> (Int, Int) @@ -236,11 +237,11 @@ postprocessImage process widget = widget{render = (imageL %~ process) <$> render widget} -- | Lens, focus tracking from app state. -focusL :: Functor f => (FocusRing Text -> f (FocusRing Text)) -> AppS -> f AppS +focusL :: Functor f => (AppR -> f AppR) -> AppS -> f AppS focusL embed s = (\newFocus -> s{focus = newFocus}) <$> embed (focus s) -- | Lens, method text entry from app state. -methodEditorL :: Functor f => (Editor Method Text -> f (Editor Method Text)) -> AppS -> f AppS +methodEditorL :: Functor f => (Editor Method AppR -> f (Editor Method AppR)) -> AppS -> f AppS methodEditorL embed s = (\newMethodEditor -> s{methodEditor = newMethodEditor}) <$> embed (methodEditor s) -- | Lens, method in text entry. @@ -254,25 +255,32 @@ overlayStateL embed s = (\newOverlay -> s{overlayState = newOverlay}) <$> embed (overlayState s) -- | Lens, location of pop-up in overlay state -methodEditorExtentL :: Functor f => (Extent Text -> f (Extent Text)) -> OverlayS -> f OverlayS +methodEditorExtentL :: Functor f => (Extent AppR -> f (Extent AppR)) -> OverlayS -> f OverlayS methodEditorExtentL embed os = (\newExtent -> os{methodEditorExtent = newExtent}) <$> embed (methodEditorExtent os) -- | Lens, method selector in overlay state -methodListL :: Functor f => (List Text Method -> f (List Text Method)) -> OverlayS -> f OverlayS +methodListL :: Functor f => (List AppR Method -> f (List AppR Method)) -> OverlayS -> f OverlayS methodListL embed os = (\newList -> os{methodList = newList}) <$> embed (methodList os) -- | Lens, URL text entry in app state -urlEditorL :: Functor f => (Editor String Text -> f (Editor String Text)) -> AppS -> f AppS +urlEditorL :: Functor f => (Editor String AppR -> f (Editor String AppR)) -> AppS -> f AppS urlEditorL embed s = (\newUrlEditor -> s{urlEditor = newUrlEditor}) <$> embed (urlEditor s) +-- | Lens, flag to use default headers useDefaultHeadersL :: Functor f => (Bool -> f Bool) -> AppS -> f AppS useDefaultHeadersL embed s = (\newUse -> s{useDefaultHeaders = newUse}) <$> embed (useDefaultHeaders s) --- | Extent name. Emitted by main UI, used to construct overlay state -methodEditorExtentName :: Text -methodEditorExtentName = "methodEditorExtent" +-- | Lens, custom headers +customHeadersL :: Functor f => ([(Bool, Header)] -> f [(Bool, Header)]) -> AppS -> f AppS +customHeadersL embed s = + (\newHeaders -> s {customHeaders = newHeaders}) <$> embed (customHeaders s) +-- | Lens, header editor (maybe) +headerEditorL :: Functor f => (Maybe (Editor Text AppR) -> f (Maybe (Editor Text AppR))) -> AppS -> f AppS +headerEditorL embed s = + (\newHEdit -> s { headerEditor = newHEdit }) <$> embed (headerEditor s) + {-| Like 'borderWithLabel' but grows the image of the inner widget so the whole label is always visible. @@ -281,13 +289,6 @@ textLabeledBorder label inner = borderWithLabel (txt label) (postprocessImage (growSpaces (textWidth label) left 0 top) inner) --- | Like 'textLabeledBorder' but allows attributes to be applied to the label. -textAttrLabeledBorder :: Text -> Attr -> Widget n -> Widget n -textAttrLabeledBorder label attr inner = - borderWithLabel - (raw $ text' attr label) - (postprocessImage (growSpaces (textWidth label) left 0 top) inner) - -- | Area between main menu and main content area mainMenuSeparator :: Widget n mainMenuSeparator = vLimit 1 $ fill '=' @@ -296,23 +297,24 @@ mainMenu :: Widget n mainMenu = hBox $ map (padLeftRight 2 . txt) [ "Headers", "Response Tools", "\x2026" ] - -{- Widget names -} -defaultHeadersEditorName :: Text -defaultHeadersEditorName = "defaultHeadersEditor" - -responseBodyViewportName :: Text -responseBodyViewportName = "responseBodyViewport" +data FocusSensitive = MkFocusSensitive + { methodWidget :: Widget AppR + , urlWidget :: Widget AppR + , defaultHeadersToggleWidget :: Widget AppR + , customHeadersWidgets :: [[Widget AppR]] + , addCustomHeaderWidget :: Widget AppR + , responseBodyWidget :: Widget AppR + } {-| Render. -Widget names are all 'Text'. +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 Text] +draw :: AppS -> [Widget AppR] draw AppS{..} = [ drawOverlay os | Just os <- [overlayState] ] ++ @@ -320,49 +322,105 @@ [ mainMenu , mainMenuSeparator , hBox - [ reportExtent methodEditorExtentName $ textLabeledBorder "Method" methodWidget + [ reportExtent MethodEditor $ textLabeledBorder "Method" methodWidget , textLabeledBorder "URL to Query?" urlWidget ] - , if useDefaultHeaders - then - textAttrLabeledBorder - "[X] Use Default Headers" - defaultHeadersAttr - (headersWidget defaultHeaders) - else raw $ text' defaultHeadersAttr " [ ] Use Default Headers" + , defaultHeadersSection ] ++ - [ textLabeledBorder "Custom Headers" (headersWidget customHeaders) | not $ null customHeaders ] - ++ - [ focusedBorder - . textLabeledBorder "Response Body" - . withVScrollBars OnRight - . withHScrollBars OnBottom - . viewport responseBodyViewportName Both - $ raw vtySafeResponse + [ textLabeledBorder "Custom Headers" + . renderTable + . surroundingBorder False + . rowBorders False + . table + $ customHeadersWidgets ++ [[addCustomHeaderWidget, txt "", txt ""]] ] + ++ + [ responseBodyWidget ] ] -- layers top to bottom where - focusDefaultHeaders = focusGetCurrent focus == Just defaultHeadersEditorName - focusedResponseBody = focusGetCurrent focus == Just responseBodyViewportName - focusedBorder = if focusedResponseBody then withBorderStyle BS.unicodeBold else id - defaultHeadersAttr = - if focusDefaultHeaders then currentAttr `withStyle` reverseVideo else currentAttr - defaultHeaders = view headers defaults - responseImage = lastResponse - vtySafeResponse = responseImage - editorWidget = withFocusRing focus (renderEditor (vBox . map str)) - urlWidget = editorWidget urlEditor - methodWidget = hLimit 18 $ hBox [editorWidget methodEditor, str "\x25BC"] + unfocusedWidgets = MkFocusSensitive + { methodWidget = methodEditorWidget False + , urlWidget = editorWidget False urlEditor + , defaultHeadersToggleWidget = defaultHeadersToggle + , customHeadersWidgets = map unfocusedHeader customHeaders + , addCustomHeaderWidget = addCustomHeader + , responseBodyWidget = responseBodyView + } + methodEditorWidget isFocused = hLimit 18 $ hBox [editorWidget isFocused methodEditor, str "\x25BC"] + editorWidget = renderEditor (vBox . map str) + usingDefaultHeadersText = "[X] Use Default Headers" + (defaultHeadersToggle, defaultHeadersSection) = + if useDefaultHeaders + then + ( txt usingDefaultHeadersText + , borderWithLabel + defaultHeadersToggleWidget + (postprocessImage (growSpaces (textWidth usingDefaultHeadersText) left 0 top) (headersWidget defaultHeaders)) + ) + else (txt "[ ] Use Default Headers", defaultHeadersToggleWidget) + where + defaultHeaders = view headers defaults + unfocusedHeader (active, (n, v)) = [unfocusedActive active, unfocusedName n, utf8 v ] + unfocusedActive active = txt . Text.singleton $ if active then 'X' else ' ' + unfocusedName = utf8 . original + addCustomHeader = txt "+" + responseBodyView = + textLabeledBorder "Response Body" + . withVScrollBars OnRight + . withHScrollBars OnBottom + . viewport ResponseBodyView Both + $ raw lastResponse + MkFocusSensitive{..} = case focus of + MethodEditor -> unfocusedWidgets { methodWidget = methodEditorWidget True } + UrlEditor -> unfocusedWidgets { urlWidget = editorWidget True urlEditor } + DefaultHeadersToggle -> unfocusedWidgets { defaultHeadersToggleWidget = focusWidget defaultHeadersToggle } + ExistingCustomHeader chResource -> unfocusedWidgets { customHeadersWidgets = customHeadersWithFocus chResource } + AddCustomHeader -> unfocusedWidgets { addCustomHeaderWidget = focusWidget addCustomHeader } + ResponseBodyView -> unfocusedWidgets { responseBodyWidget = withBorderStyle unicodeBold responseBodyView } + MethodSelector -> unfocusedWidgets + customHeadersWithFocus MkCustomHeaderR{..} = zipWith headerRow [0..] customHeaders + where + headerRow i = if listIndex == i then focusedRow else unfocusedHeader + focusedRow (active, (n, v)) = case column of + ActiveToggle -> [focusWidget activeWidget, nameWidget, valueWidget] + NameEditor -> [activeWidget, maybe (focusWidget nameWidget) renderHeaderEditor headerEditor, valueWidget] + ValueEditor -> [activeWidget, nameWidget, maybe (focusWidget valueWidget) renderHeaderEditor headerEditor] + where + activeWidget = unfocusedActive active + nameWidget = unfocusedName n + valueWidget = utf8 v + renderHeaderEditor hedit = + hLimit (foldr (max . succ . textWidth) 1 $ getEditContents hedit) + . vLimit 1 + $ renderEditor (vBox . map txt) True hedit +focusStyle :: Style -> Style +focusStyle x = x `xor` reverseVideo + +focusAttr :: Attr -> Attr +focusAttr attr = attr { attrStyle = SetTo newStyle } + where + newStyle = case attrStyle attr of + Default -> reverseVideo + KeepCurrent -> reverseVideo + SetTo style -> focusStyle style + +focusWidget :: Widget n -> Widget n +focusWidget = modifyDefAttr focusAttr + +utf8 :: ByteString -> Widget n +utf8 bytes = Widget Fixed Fixed $ do + c <- getContext + return emptyResult { image = utf8Bytestring' (c ^. attrL) bytes } + headersWidget :: [Header] -> Widget n headersWidget = renderTable . surroundingBorder False . rowBorders False . table . map headerRow where - headerRow (n, v) = - [raw . utf8Bytestring' currentAttr $ original n, raw $ utf8Bytestring' currentAttr v] + headerRow (n, v) = [utf8 $ original n, utf8 v] -- | When the overlay is present, what are the widget to draw on that layer. -drawOverlay :: OverlayS -> Widget Text +drawOverlay :: OverlayS -> Widget AppR drawOverlay OverlayS{..} = translateBy transLoc . hLimit w . textLabeledBorder "Method (Select)" $ methodSelectWidget where @@ -372,20 +430,105 @@ mv = Vector.length (listElements methodList) * listItemHeight methodList -- | Where to place the cursor? If overlay present, no cursor. Otherwise determined by 'focus' -chooseCursor :: AppS -> [CursorLocation Text] -> Maybe (CursorLocation Text) -chooseCursor s = - case overlayState s of - Nothing -> focusRingCursor focus s - Just os -> showCursorNamed (getName $ methodList os) +chooseCursor :: AppS -> [CursorLocation AppR] -> Maybe (CursorLocation AppR) +chooseCursor s = showCursorNamed $ case overlayState s of + Nothing -> focus s + Just _ -> MethodSelector -- | App state change on [Tab] to advace the focus. moveFocusNext :: AppS -> AppS -moveFocusNext = focusL %~ focusNext +moveFocusNext s = focusNext (customHeaders s) (focus s) s + where + focusNext cheaders = \case + MethodEditor -> focusL .~ UrlEditor + UrlEditor -> focusL .~ DefaultHeadersToggle + DefaultHeadersToggle -> focusL .~ nextFocus + where + nextFocus = + if null cheaders + then AddCustomHeader + else ExistingCustomHeader MkCustomHeaderR { listIndex = 0, column = ActiveToggle } + ExistingCustomHeader MkCustomHeaderR{..} -> \os -> case splitAt listIndex cheaders of + (initHdrs, (flag, (name, value)) : tailHdrs) -> case column of + ActiveToggle -> os + { focus = nextFocus + , headerEditor = Just $ editorText nextFocus (Just 1) (decodeUtf8Lenient $ original name) + } + where + nextFocus = ExistingCustomHeader MkCustomHeaderR { listIndex, column = NameEditor } + NameEditor -> 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 = ExistingCustomHeader MkCustomHeaderR { listIndex, column = ValueEditor } + ValueEditor -> + if null tailHdrs + then os + { focus = AddCustomHeader + , headerEditor = Nothing + , customHeaders = + initHdrs ++ [(flag, (name, valueViaEditor))] + } + else os + { focus = ExistingCustomHeader MkCustomHeaderR { listIndex = succ listIndex, column = ActiveToggle } + , headerEditor = Nothing + , customHeaders = + initHdrs ++ (flag, (name, valueViaEditor)) : tailHdrs + } + where + valueViaEditor = maybe value getEditorUtf8 (headerEditor os) + _ -> os { focus = AddCustomHeader, headerEditor = Nothing } -- NB: invalid focus + AddCustomHeader -> focusL .~ ResponseBodyView + ResponseBodyView -> focusL .~ MethodEditor + MethodSelector -> focusL .~ MethodEditor -- NB: invalid focus -- | App state change on [S+Tab] to recede the focus moveFocusPrev :: AppS -> AppS -moveFocusPrev = focusL %~ focusPrev +moveFocusPrev s = case focus s of + MethodEditor -> s { focus = ResponseBodyView } + UrlEditor -> s { focus = MethodEditor } + DefaultHeadersToggle -> s { focus = UrlEditor } + ExistingCustomHeader MkCustomHeaderR { .. } -> case splitAt listIndex $ customHeaders s of + (initHdrs, (flag, (name, value)) : tailHdrs) -> case column of + ActiveToggle -> case unsnoc initHdrs of + Nothing -> s { focus = DefaultHeadersToggle } + Just (_, (_, (_, lastValue))) -> s + { focus = newFocus + , headerEditor = Just . editorText newFocus (Just 1) $ decodeUtf8Lenient lastValue + } + where newFocus = ExistingCustomHeader MkCustomHeaderR { listIndex = pred listIndex, column = ValueEditor } + NameEditor -> s + { focus = ExistingCustomHeader MkCustomHeaderR { listIndex, column = ActiveToggle } + , headerEditor = Nothing + , customHeaders = + initHdrs ++ (flag, (maybe name (CaseInsensitive.mk . getEditorUtf8) (headerEditor s), value)) : tailHdrs + } + ValueEditor -> s + { focus = newFocus + , headerEditor = Just . editorText newFocus (Just 1) . decodeUtf8Lenient $ original name + , customHeaders = + initHdrs ++ (flag, (name, maybe value getEditorUtf8 $ headerEditor s)) : tailHdrs + } + where + newFocus = ExistingCustomHeader MkCustomHeaderR { listIndex, column = NameEditor } + _ -> s { focus = DefaultHeadersToggle, headerEditor = Nothing } -- NB: invalid focus + AddCustomHeader -> case unsnoc $ customHeaders s of + Nothing -> s { focus = DefaultHeadersToggle } + Just (initHdrs, (_, (_, value))) -> s + { focus = newFocus + , headerEditor = Just $ editorText newFocus (Just 1) (decodeUtf8Lenient value) + } + where + newFocus = ExistingCustomHeader MkCustomHeaderR { listIndex = length initHdrs, column = ValueEditor } + ResponseBodyView -> s { focus = AddCustomHeader } + MethodSelector -> s { focus = ResponseBodyView } -- NB: invalid focus + {-| State update in response to event. @@ -398,7 +541,7 @@ Other Vty events are passed to 'handleEventLocal'. -} -handleEvent :: BrickEvent Text Void -> EventM Text AppS () +handleEvent :: BrickEvent AppR Void -> EventM AppR AppS () handleEvent (VtyEvent (EvKey KEsc _)) = halt -- global: [ESC]: exit cleanly handleEvent (VtyEvent e@(EvKey (KChar 'q') mods)) = -- global Ctrl+q: exit cleanly if MCtrl `elem` mods @@ -413,7 +556,7 @@ 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 Text AppS () +handleEventLocal :: Event -> EventM AppR AppS () handleEventLocal e = do mos <- gets overlayState -- switch to different behavior based on overlay @@ -430,7 +573,7 @@ * [Space] on the default headers editor toggles the setting. * If an editor is focused, other events update it. -} -handleEventMain :: Event -> EventM Text AppS () +handleEventMain :: Event -> EventM AppR AppS () handleEventMain (EvKey KEnter _) = get >>= suspendAndResume . doRequest handleEventMain (EvKey (KChar '\t') mods) = -- change focus modify $ if MShift `elem` mods @@ -442,31 +585,32 @@ else moveFocusPrev handleEventMain evt = do -- Depends on focus s <- get - case focusGetCurrent (focus s) of - Nothing -> pure () - Just nm | nm == getName (urlEditor s) -> handleEditorLEvent urlEditorL evt - Just nm | nm == getName (methodEditor s) -> handleMethodEditorEvent evt - Just nm | nm == defaultHeadersEditorName -> handleDefaultHeadersEditorEvent evt - Just nm | nm == responseBodyViewportName -> handleResponseBodyViewportEvent evt - Just _u -> pure () -- unknown focus (log?) + case focus s of + UrlEditor -> handleEditorLEvent urlEditorL evt + MethodEditor -> handleMethodEditorEvent evt + DefaultHeadersToggle -> handleDefaultHeadersEditorEvent evt + ExistingCustomHeader chResource -> handleCustomHeaderEvent chResource evt + AddCustomHeader -> handleAddCustomHeaderEvent evt + ResponseBodyView -> handleResponseBodyViewportEvent evt + MethodSelector -> pure () -- NB: invalid focus / should be in handleEventOverlay -- | Pass event into 'handleEditorEvent', when not handled more specifically. -handleEditorLEvent :: ALens' AppS (Editor String Text) -> Event -> EventM Text AppS () +handleEditorLEvent :: ALens' AppS (Editor String AppR) -> Event -> EventM AppR AppS () handleEditorLEvent editorL evt = zoom (cloneLens editorL) (handleEditorEvent $ VtyEvent 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 Text AppS () +handleMethodEditorEvent :: Event -> EventM AppR AppS () handleMethodEditorEvent (EvKey KDown _mods) = do s <- get let enteredMethod = view methodL s listContents = Vector.fromList . nub $ enteredMethod : knownMethods - mMethodEditorExtent <- lookupExtent methodEditorExtentName + mMethodEditorExtent <- lookupExtent MethodEditor for_ mMethodEditorExtent $ \methodEditorExtent -> let - initialListState = set listSelectedL (Just 0) $ BrickList.list "methodSelector" listContents 1 + initialListState = set listSelectedL (Just 0) $ BrickList.list MethodSelector listContents 1 overlay = OverlayS { methodList = initialListState , methodEditorExtent = methodEditorExtent @@ -483,7 +627,7 @@ -- * [PgUp]: page scroll up -- * : 3 line scroll up -- * : 3 line scroll down -handleResponseBodyViewportEvent :: Event -> EventM Text AppS () +handleResponseBodyViewportEvent :: Event -> EventM AppR AppS () handleResponseBodyViewportEvent evt = case evt of EvKey k _mods -> @@ -506,17 +650,46 @@ _ -> pure () -- ignored _ -> pure () -- ignored where - vps = viewportScroll responseBodyViewportName + vps = viewportScroll ResponseBodyView -- | Handle event when focus in on default headers editor and will not change. -handleDefaultHeadersEditorEvent :: Event -> EventM Text AppS () +handleDefaultHeadersEditorEvent :: Event -> EventM AppR AppS () handleDefaultHeadersEditorEvent (EvKey (KChar ' ') _) = useDefaultHeadersL %= not handleDefaultHeadersEditorEvent _ = 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 MkCustomHeaderR { listIndex, column = ActiveToggle } (EvKey (KChar ' ') _) = + customHeadersL %= toggleHeader + where + toggleHeader oldHeaders = case splitAt listIndex oldHeaders of + (initHdrs, (flag, hdr) : tailHdrs) -> initHdrs ++ (not flag, hdr) : tailHdrs + _ -> oldHeaders -- Invalid Index +handleCustomHeaderEvent _ evt = zoom (headerEditorL . _Just) . handleEditorEvent $ VtyEvent evt + +-- | SP creates a new header. +handleAddCustomHeaderEvent :: Event -> EventM AppR AppS () +handleAddCustomHeaderEvent (EvKey (KChar ' ') _) = modify addNewCustomHeader + where + addNewCustomHeader oldState = oldState + { customHeaders = oldCustomHeaders ++ [(True, (CaseInsensitive.mk newName, ByteString.empty))] + , focus = newFocus + , headerEditor = Just . editorText newFocus (Just 1) $ decodeUtf8Lenient newName + } + where + oldCustomHeaders = customHeaders oldState + newName = ByteString.empty + newFocus = ExistingCustomHeader MkCustomHeaderR { listIndex = length oldCustomHeaders, column = NameEditor } +handleAddCustomHeaderEvent _ = pure () + -- | Retrieve extent emitted during last draw and update overlay state. -updateExtent :: EventM Text OverlayS () +updateExtent :: EventM AppR OverlayS () updateExtent = do - mExtent <- lookupExtent methodEditorExtentName + mExtent <- lookupExtent MethodEditor for_ mExtent $ \extent -> modify $ set methodEditorExtentL extent @@ -527,7 +700,7 @@ All code paths should 'updateExtent', in case the pop-up needs to move. -} -handleEventOverlay :: OverlayS -> Event -> EventM Text AppS () +handleEventOverlay :: OverlayS -> Event -> EventM AppR AppS () handleEventOverlay currentOverlay (EvKey KEnter _) = do -- pick selected method, remove popup mSelectedMethod <- fmap snd . nestEventM currentOverlay $ do updateExtent @@ -538,6 +711,9 @@ updateExtent zoom methodListL (handleListEvent e) +getEditorUtf8 :: Editor Text n -> ByteString +getEditorUtf8 = encodeUtf8 . mconcat . 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 @@ -551,7 +727,19 @@ pure $ syntaxHighlightResponse (pure $ view responseBody response) (responseContentType response) pure s{ lastResponse = either exResponse id result } where - updateHeaders AppS{..} = if useDefaultHeaders then (++ customHeaders) else const customHeaders + justSndIfFst (active, value) = if active then Just value else Nothing + updateHeaders AppS{..} = if useDefaultHeaders then (++ activeCustomHeaders) else const activeCustomHeaders + where + activeCustomHeaders = case focus of + ExistingCustomHeader MkCustomHeaderR{..} -> catMaybes $ zipWith focusedOrSaved [0..] customHeaders + where + focusedOrSaved _i (False, _) = Nothing + focusedOrSaved i (True, hdr) = if listIndex == i then Just $ focusByColumn hdr else Just hdr + focusByColumn hdr = case column of + ActiveToggle -> hdr + NameEditor -> (maybe (fst hdr) (CaseInsensitive.mk . getEditorUtf8) headerEditor, snd hdr) + ValueEditor -> (fst hdr, maybe (snd hdr) getEditorUtf8 headerEditor) + _ -> mapMaybe justSndIfFst customHeaders httpMethod AppS{..} = concat . getText $ view editContentsL methodEditor httpOptions = headers %~ updateHeaders s httpRequest opts = diff --git a/src/Types.hs b/src/Types.hs --- a/src/Types.hs +++ b/src/Types.hs @@ -2,6 +2,9 @@ ( -- * Global Types for TUI manipulation AppS(..) , OverlayS(..) + , AppR(..) + , CustomHeaderR(..) + , CustomHeaderColumn(..) -- * Range Ord-like types and helpers , RangeInAlign(..) , VertAlign @@ -12,7 +15,6 @@ -- brick -import Brick.Focus (FocusRing) import Brick.Types (Extent) import Brick.Widgets.Edit (Editor) import Brick.Widgets.List (List) @@ -20,12 +22,12 @@ -- bytestring import qualified Data.ByteString.Lazy as Lazy (ByteString) --- text -import Data.Text (Text) - -- http-client import qualified Network.HTTP.Client as HC +-- text +import Data.Text (Text) + -- vty import Graphics.Vty.Image (Image) @@ -40,25 +42,48 @@ Widget names are all 'Text' values. -} data AppS = AppS - { focus :: FocusRing Text -- ^ Focus tracking within the main interface. - , methodEditor :: Editor Method Text -- ^ text entry for the HTTP method to use for request - , overlayState :: Maybe OverlayS -- ^ If not Nothing, the overlay is displayed with this state - , urlEditor :: !(Editor String Text) -- ^ text entry for URL to request + { focus :: AppR -- ^ Focus tracking within the main interface. + , methodEditor :: !(Editor Method AppR) -- ^ text entry for the HTTP method to use for request + , overlayState :: !(Maybe OverlayS) -- ^ If not Nothing, the overlay is displayed with this state + , urlEditor :: !(Editor String AppR) -- ^ text entry for URL to request , lastResponse :: !Image -- ^ Either the response body, or an error message - , useDefaultHeaders :: Bool -- ^ If False, replace with; otherwise append custom headers - , customHeaders :: [Header] -- ^ additional/replacement request headers - , payload :: Maybe Lazy.ByteString -- ^ just the request body, no content type / filename - , connManager :: HC.Manager -- ^ HTTP connection manager + , useDefaultHeaders :: !Bool -- ^ If False, replace with; otherwise append custom headers + , customHeaders :: ![(Bool, Header)] -- ^ additional/replacement request headers, and active flag + , headerEditor :: !(Maybe (Editor Text AppR)) -- ^ When a custom header name or value is being edited, non-Nothing + , payload :: !(Maybe Lazy.ByteString) -- ^ just the request body, no content type / filename + , connManager :: !HC.Manager -- ^ HTTP connection manager } {-| State of the UI overlay, which is currently just the "pop-up" for the method selector. -} data OverlayS = OverlayS - { methodEditorExtent :: Extent Text -- ^ Where the pop-up should start - , methodList :: List Text Method -- ^ Method selection + { methodEditorExtent :: Extent AppR -- ^ Where the pop-up should start + , methodList :: List AppR Method -- ^ Method selection } +-- | Application Resource Name +data AppR + = MethodEditor + | UrlEditor + | DefaultHeadersToggle + | ExistingCustomHeader CustomHeaderR + | AddCustomHeader + | ResponseBodyView + | MethodSelector + deriving (Eq, Ord, Show) + +data CustomHeaderR = MkCustomHeaderR + { listIndex :: !Int -- ^ target in 'customHeaders' from 'AppS' + , column :: !CustomHeaderColumn + } + deriving (Eq, Ord, Show) + +data CustomHeaderColumn + = ActiveToggle + | NameEditor + | ValueEditor + deriving (Eq, Ord, Show) -- | Alignment of one range strictly within another range both over a discete, totally ordered set. data RangeInAlign diff --git a/src/UI.hs b/src/UI.hs --- a/src/UI.hs +++ b/src/UI.hs @@ -10,7 +10,6 @@ -- brick import Brick.AttrMap (AttrMap) import qualified Brick.AttrMap as Brick -import Brick.Focus (focusRing, focusSetCurrent) import Brick.Main (App(..), defaultMain) import Brick.Widgets.Border (borderAttr) import Brick.Widgets.Edit (editor) @@ -38,14 +37,7 @@ -- local libs import HTTP.Client (Header, UseDefaultHeaders, robustSettings) import Lib - ( chooseCursor - , defaultHeadersEditorName - , doRequest - , draw - , handleEvent - , responseBodyViewportName - ) -import Types (AppS(..)) +import Types -- | Empty attribute map @@ -90,17 +82,14 @@ , appAttrMap = attrMap } initialState m = AppS - { focus = - focusSetCurrent urlEditorName - $ focusRing [methodEditorName, urlEditorName, defaultHeadersEditorName, responseBodyViewportName] - , methodEditor = editor methodEditorName (Just 1) method + { focus = UrlEditor + , methodEditor = editor MethodEditor (Just 1) method , overlayState = Nothing - , urlEditor = editor urlEditorName (Just 1) (T.unpack $ fromMaybe "" uri) + , urlEditor = editor UrlEditor (Just 1) (T.unpack $ fromMaybe "" uri) , lastResponse = emptyImage , useDefaultHeaders = toEnum $ fromEnum useDefault - , customHeaders = custHeaders + , customHeaders = map (True,) custHeaders + , headerEditor = Nothing , payload = payloadLbs , connManager = m } - methodEditorName = "methodEditor" - urlEditorName = "urlEditor"