restman-0.7.1.1: src/UI.hs

{-# language OverloadedStrings #-}

module UI
    ( startUI
    ) where

-- base
import Data.Maybe (fromMaybe)

-- 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)
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
  ( chooseCursor
  , defaultHeadersEditorName
  , doRequest
  , draw
  , handleEvent
  , responseBodyViewportName
  )
import Types (AppS(..))


-- | Empty attribute map
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
    }

{-|
As the poor name implies, not sure what to call the library entry point, or really even what it
should look like at this point.
-}
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 $ initialState manager
    Just{} -> doRequest $ initialState manager
  _ <- defaultMain app uiState
  pure ()
 where
  app = App
    { appDraw = draw
    , appChooseCursor = chooseCursor
    , appHandleEvent = handleEvent
    , appStartEvent = pure ()
    , appAttrMap = attrMap
    }
  initialState m = AppS
    { focus =
        focusSetCurrent urlEditorName
          $ focusRing [methodEditorName, urlEditorName, defaultHeadersEditorName, responseBodyViewportName]
    , methodEditor = editor methodEditorName (Just 1) method
    , overlayState = Nothing
    , urlEditor = editor urlEditorName (Just 1) (T.unpack $ fromMaybe "" uri)
    , lastResponse = emptyImage
    , useDefaultHeaders = toEnum $ fromEnum useDefault
    , customHeaders = custHeaders
    , payload = payloadLbs
    , connManager = m
    }
  methodEditorName = "methodEditor"
  urlEditorName = "urlEditor"