{-# language OverloadedStrings #-} {-| Module: UI Top-level Brick application wiring for RESTman. 'mkInitialState' builds the initial 'AppS' from the values parsed on the command line. 'startUI' creates the HTTP manager, optionally performs an initial request when a URI is supplied, and hands control to the Brick main loop. The Brick 'App' record is assembled here; the individual draw, event-handling, and cursor functions live in "Lib". -} module UI ( -- * Application entry points mkInitialState , startUI ) where -- base import Data.Maybe (fromMaybe) -- brick import Brick.AttrMap (AttrMap) import qualified Brick.AttrMap as Brick import Brick.Main (App(..), defaultMain) import Brick.Widgets.Border (borderAttr) import Brick.Widgets.Edit (editor) import Brick.Widgets.List (listSelectedFocusedAttr) -- bytestring import qualified Data.ByteString.Lazy as Lazy (ByteString) -- http-client import qualified Network.HTTP.Client as HC -- text import Data.Text (Text) import qualified Data.Text as T -- vty import Graphics.Vty.Attributes ( Attr(Attr, attrBackColor, attrForeColor, attrStyle, attrURL) , MaybeDefault(Default, SetTo) , currentAttr , reverseVideo ) import Graphics.Vty.Image (emptyImage) -- local libs import HTTP.Client (Header, UseDefaultHeaders, robustSettings) import Lib import Types -- | Attribute map for the application. Sets reverse-video for the focused list item and -- resets the border attribute to terminal defaults so borders inherit the terminal colour scheme. attrMap :: AppS -> AttrMap attrMap _ = Brick.attrMap currentAttr [ (listSelectedFocusedAttr, currentAttr {attrStyle = SetTo reverseVideo}) , (borderAttr, termDefaults) ] where termDefaults = Attr { attrStyle = Default , attrForeColor = Default , attrBackColor = Default , attrURL = Default } -- | Build the initial 'AppS' from command-line arguments and an HTTP manager. mkInitialState :: HC.Manager -- ^ HTTP connection manager -> String -- ^ Initial HTTP method -> UseDefaultHeaders -- ^ How to handle default headers -> [Header] -- ^ Additional or replacement headers -> Maybe Lazy.ByteString -- ^ Payload or Nothing -> Maybe Text -- ^ URI or Nothing -> AppS mkInitialState m method useDefault custHeaders payloadLbs uri = AppS { focus = UrlEditor , methodEditor = editor MethodEditor (Just 1) method , overlayState = Nothing , urlEditor = editor UrlEditor (Just 1) (T.unpack $ fromMaybe "" uri) , lastResponse = emptyImage , useDefaultHeaders = toEnum $ fromEnum useDefault , customHeaders = map (True,) custHeaders , headerEditor = Nothing , payload = payloadLbs , connManager = m } {-| Launch the RESTman TUI. Creates a new HTTP 'HC.Manager' using 'robustSettings', builds the initial 'AppS' via 'mkInitialState', and — if a URI was supplied — fires an initial request before entering the Brick event loop. -} startUI :: String -- ^ Initial HTTP method -> UseDefaultHeaders -- ^ how to handle default headers -> [Header] -- ^ additional or replacement headers -> Maybe Lazy.ByteString -- ^ payload or Nothing -> Maybe Text -- ^ uri or Nothing -> IO () startUI method useDefault custHeaders payloadLbs uri = do manager <- HC.newManager robustSettings uiState <- case uri of Nothing -> pure $ mkInitialState manager method useDefault custHeaders payloadLbs uri Just{} -> doRequest $ mkInitialState manager method useDefault custHeaders payloadLbs uri _ <- defaultMain app uiState pure () where app = App { appDraw = draw , appChooseCursor = chooseCursor , appHandleEvent = handleEvent , appStartEvent = pure () , appAttrMap = attrMap }