restman 0.7.1.2 → 0.7.2.0
raw patch · 5 files changed
+362/−146 lines, 5 filesdep ~lensdep ~mime-typesdep ~wreq
Dependency ranges changed: lens, mime-types, wreq
Files
- CHANGELOG.md +13/−0
- restman.cabal +6/−5
- src/Lib.hs +298/−110
- src/Types.hs +39/−14
- src/UI.hs +6/−17
CHANGELOG.md view
@@ -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
restman.cabal view
@@ -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
src/Lib.hs view
@@ -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 -- * <ScrollUp>: 3 line scroll up -- * <ScrollDown>: 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 =
src/Types.hs view
@@ -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
src/UI.hs view
@@ -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"