    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    module Brick.Types.Internal
      ( ScrollRequest(..)
      , VisibilityRequest(..)
      , vrPositionL
      , vrSizeL
      , Location(..)
      , locL
      , origin
      , TerminalLocation(..)
      , Viewport(..)
      , ViewportType(..)
      , RenderState(..)
      , Direction(..)
      , CursorLocation(..)
      , cursorLocationL
      , cursorLocationNameL
      , Context(..)
      , EventState(..)
      , EventRO(..)
      , Next(..)
      , Result(..)
      , Extent(..)
      , CacheInvalidateRequest(..)
      , BrickEvent(..)

      , rsScrollRequestsL
      , viewportMapL
      , clickableNamesL
      , renderCacheL
      , observedNamesL
      , vpSize
      , vpLeft
      , vpTop
      , imageL
      , cursorsL
      , extentsL
      , visibilityRequestsL
      , emptyResult
      )
    where

    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid
    #endif

    import Lens.Micro (_1, _2, Lens')
    import Lens.Micro.TH (makeLenses)
    import Lens.Micro.Internal (Field1, Field2)
    import qualified Data.Set as S
    import qualified Data.Map as M
    import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, emptyImage)

    import Brick.Types.TH
    import Brick.AttrMap (AttrName, AttrMap)
    import Brick.Widgets.Border.Style (BorderStyle)

    data ScrollRequest = HScrollBy Int
                       | HScrollPage Direction
                       | HScrollToBeginning
                       | HScrollToEnd
                       | VScrollBy Int
                       | VScrollPage Direction
                       | VScrollToBeginning
                       | VScrollToEnd
                       | SetTop Int
                       | SetLeft Int

    data VisibilityRequest =
        VR { vrPosition :: Location
           , vrSize :: DisplayRegion
           }
           deriving (Show, Eq)

    -- | Describes the state of a viewport as it appears as its most recent
    -- rendering.
    data Viewport =
        VP { _vpLeft :: Int
           -- ^ The column offset of left side of the viewport.
           , _vpTop :: Int
           -- ^ The row offset of the top of the viewport.
           , _vpSize :: DisplayRegion
           -- ^ The size of the viewport.
           }
           deriving Show

    -- | The type of viewports that indicates the direction(s) in which a
    -- viewport is scrollable.
    data ViewportType = Vertical
                      -- ^ Viewports of this type are scrollable only vertically.
                      | Horizontal
                      -- ^ Viewports of this type are scrollable only horizontally.
                      | Both
                      -- ^ Viewports of this type are scrollable vertically and horizontally.
                      deriving (Show, Eq)

    data CacheInvalidateRequest n = InvalidateSingle n
                                  | InvalidateEntire

    data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)]
                           , cacheInvalidateRequests :: [CacheInvalidateRequest n]
                           }

    -- | An extent of a named area: its size, location, and origin.
    data Extent n = Extent { extentName      :: n
                           , extentUpperLeft :: Location
                           , extentSize      :: (Int, Int)
                           , extentOffset    :: Location
                           }
                  deriving (Show)

    data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport
                             , eventVtyHandle :: Maybe Vty
                             , latestExtents :: [Extent n]
                             }

    -- | The type of actions to take upon completion of an event handler.
    data Next a = Continue a
                | SuspendAndResume (IO a)
                | Halt a
                deriving Functor

    -- | Scrolling direction.
    data Direction = Up
                   -- ^ Up/left
                   | Down
                   -- ^ Down/right
                   deriving (Show, Eq)

    -- | A terminal screen location.
    data Location = Location { loc :: (Int, Int)
                             -- ^ (Column, Row)
                             }
                    deriving (Show, Eq)

    suffixLenses ''Location

    instance Field1 Location Location Int Int where
        _1 = locL._1

    instance Field2 Location Location Int Int where
        _2 = locL._2

    -- | The class of types that behave like terminal locations.
    class TerminalLocation a where
        -- | Get the column out of the value
        locationColumnL :: Lens' a Int
        locationColumn :: a -> Int

        -- | Get the row out of the value
        locationRowL :: Lens' a Int
        locationRow :: a -> Int

    instance TerminalLocation Location where
        locationColumnL = _1
        locationColumn (Location t) = fst t
        locationRowL = _2
        locationRow (Location t) = snd t

    -- | The origin (upper-left corner).
    origin :: Location
    origin = Location (0, 0)

    instance Monoid Location where
        mempty = origin
        mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)

    -- | A cursor location.  These are returned by the rendering process.
    data CursorLocation n =
        CursorLocation { cursorLocation :: !Location
                       -- ^ The location
                       , cursorLocationName :: !(Maybe n)
                       -- ^ The name of the widget associated with the location
                       }
                       deriving Show

    -- | The type of result returned by a widget's rendering function. The
    -- result provides the image, cursor positions, and visibility requests
    -- that resulted from the rendering process.
    data Result n =
        Result { image :: Image
               -- ^ The final rendered image for a widget
               , cursors :: [CursorLocation n]
               -- ^ The list of reported cursor positions for the
               -- application to choose from
               , visibilityRequests :: [VisibilityRequest]
               -- ^ The list of visibility requests made by widgets rendered
               -- while rendering this one (used by viewports)
               , extents :: [Extent n]
               }
               deriving Show

    suffixLenses ''Result

    emptyResult :: Result n
    emptyResult = Result emptyImage [] [] []

    -- | The type of events.
    data BrickEvent n e = VtyEvent Event
                        -- ^ The event was a Vty event.
                        | AppEvent e
                        -- ^ The event was an application event.
                        | MouseDown n Button [Modifier] Location
                        -- ^ A mouse-down event on the specified region was
                        -- received.
                        | MouseUp n (Maybe Button) Location
                        -- ^ A mouse-up event on the specified region was
                        -- received.
                        deriving (Show, Eq)

    data RenderState n =
        RS { viewportMap :: M.Map n Viewport
           , rsScrollRequests :: [(n, ScrollRequest)]
           , observedNames :: !(S.Set n)
           , renderCache :: M.Map n (Result n)
           , clickableNames :: [n]
           }

    -- | The rendering context. This tells widgets how to render: how much
    -- space they have in which to render, which attribute they should use
    -- to render, which bordering style should be used, and the attribute map
    -- available for rendering.
    data Context =
        Context { ctxAttrName :: AttrName
                , availWidth :: Int
                , availHeight :: Int
                , ctxBorderStyle :: BorderStyle
                , ctxAttrMap :: AttrMap
                }
                deriving Show

    suffixLenses ''RenderState
    suffixLenses ''VisibilityRequest
    suffixLenses ''CursorLocation
    makeLenses ''Viewport