{-# 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 :: AppS -> AttrMap
attrMap AppS
_ =
  Attr -> [(AttrName, Attr)] -> AttrMap
Brick.attrMap Attr
currentAttr
    [ (AttrName
listSelectedFocusedAttr, Attr
currentAttr {attrStyle = SetTo reverseVideo})
    , (AttrName
borderAttr, Attr
termDefaults)
    ]
 where
  termDefaults :: Attr
termDefaults = Attr
    { attrStyle :: MaybeDefault Style
attrStyle = MaybeDefault Style
forall v. MaybeDefault v
Default
    , attrForeColor :: MaybeDefault Color
attrForeColor = MaybeDefault Color
forall v. MaybeDefault v
Default
    , attrBackColor :: MaybeDefault Color
attrBackColor = MaybeDefault Color
forall v. MaybeDefault v
Default
    , attrURL :: MaybeDefault Text
attrURL = MaybeDefault Text
forall v. MaybeDefault v
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 :: Manager
-> Method
-> UseDefaultHeaders
-> [Header]
-> Maybe ByteString
-> Maybe Text
-> AppS
mkInitialState Manager
m Method
method UseDefaultHeaders
useDefault [Header]
custHeaders Maybe ByteString
payloadLbs Maybe Text
uri = AppS
  { focus :: AppR
focus = AppR
UrlEditor
  , methodEditor :: Editor Method AppR
methodEditor = AppR -> Maybe Int -> Method -> Editor Method AppR
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor AppR
MethodEditor (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Method
method
  , overlayState :: Maybe OverlayS
overlayState = Maybe OverlayS
forall a. Maybe a
Nothing
  , urlEditor :: Editor Method AppR
urlEditor = AppR -> Maybe Int -> Method -> Editor Method AppR
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor AppR
UrlEditor (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) (Text -> Method
T.unpack (Text -> Method) -> Text -> Method
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
uri)
  , lastResponse :: Image
lastResponse = Image
emptyImage
  , useDefaultHeaders :: Bool
useDefaultHeaders = Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ UseDefaultHeaders -> Int
forall a. Enum a => a -> Int
fromEnum UseDefaultHeaders
useDefault
  , customHeaders :: [(Bool, Header)]
customHeaders = (Header -> (Bool, Header)) -> [Header] -> [(Bool, Header)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
True,) [Header]
custHeaders
  , headerEditor :: Maybe (Editor Text AppR)
headerEditor = Maybe (Editor Text AppR)
forall a. Maybe a
Nothing
  , payload :: Maybe ByteString
payload = Maybe ByteString
payloadLbs
  , connManager :: Manager
connManager = Manager
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
-> UseDefaultHeaders
-> [Header]
-> Maybe ByteString
-> Maybe Text
-> IO ()
startUI Method
method UseDefaultHeaders
useDefault [Header]
custHeaders Maybe ByteString
payloadLbs Maybe Text
uri = do
  manager <- ManagerSettings -> IO Manager
HC.newManager ManagerSettings
robustSettings
  uiState <- case uri of
    Maybe Text
Nothing -> AppS -> IO AppS
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppS -> IO AppS) -> AppS -> IO AppS
forall a b. (a -> b) -> a -> b
$ Manager
-> Method
-> UseDefaultHeaders
-> [Header]
-> Maybe ByteString
-> Maybe Text
-> AppS
mkInitialState Manager
manager Method
method UseDefaultHeaders
useDefault [Header]
custHeaders Maybe ByteString
payloadLbs Maybe Text
uri
    Just{} -> AppS -> IO AppS
doRequest (AppS -> IO AppS) -> AppS -> IO AppS
forall a b. (a -> b) -> a -> b
$ Manager
-> Method
-> UseDefaultHeaders
-> [Header]
-> Maybe ByteString
-> Maybe Text
-> AppS
mkInitialState Manager
manager Method
method UseDefaultHeaders
useDefault [Header]
custHeaders Maybe ByteString
payloadLbs Maybe Text
uri
  _ <- defaultMain app uiState
  pure ()
 where
  app :: App AppS Void AppR
app = App
    { appDraw :: AppS -> [Widget AppR]
appDraw = AppS -> [Widget AppR]
draw
    , appChooseCursor :: AppS -> [CursorLocation AppR] -> Maybe (CursorLocation AppR)
appChooseCursor = AppS -> [CursorLocation AppR] -> Maybe (CursorLocation AppR)
chooseCursor
    , appHandleEvent :: BrickEvent AppR Void -> EventM AppR AppS ()
appHandleEvent = BrickEvent AppR Void -> EventM AppR AppS ()
handleEvent
    , appStartEvent :: EventM AppR AppS ()
appStartEvent = () -> EventM AppR AppS ()
forall a. a -> EventM AppR AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , appAttrMap :: AppS -> AttrMap
appAttrMap = AppS -> AttrMap
attrMap
    }