{-# LANGUAGE TemplateHaskell #-}
module Vgrep.Environment
    ( Environment (..)
    , Viewport (..)

    -- * Auto-generated Lenses
    , config
    , viewport
    , vpHeight
    , vpWidth

    -- * Convenience Lenses
    , viewportWidth
    , viewportHeight

    -- * Re-exports
    , module Vgrep.Environment.Config
    ) where

import Control.Lens.Compat

import Vgrep.Environment.Config


-- | The bounds (width and height) of a display viewport.
data Viewport = Viewport { Viewport -> Int
_vpWidth :: Int, Viewport -> Int
_vpHeight :: Int }
    deriving (Viewport -> Viewport -> Bool
(Viewport -> Viewport -> Bool)
-> (Viewport -> Viewport -> Bool) -> Eq Viewport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Viewport -> Viewport -> Bool
$c/= :: Viewport -> Viewport -> Bool
== :: Viewport -> Viewport -> Bool
$c== :: Viewport -> Viewport -> Bool
Eq, Int -> Viewport -> ShowS
[Viewport] -> ShowS
Viewport -> String
(Int -> Viewport -> ShowS)
-> (Viewport -> String) -> ([Viewport] -> ShowS) -> Show Viewport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Viewport] -> ShowS
$cshowList :: [Viewport] -> ShowS
show :: Viewport -> String
$cshow :: Viewport -> String
showsPrec :: Int -> Viewport -> ShowS
$cshowsPrec :: Int -> Viewport -> ShowS
Show)

makeLenses ''Viewport


-- | 'Vgrep.Type.VgrepT' actions can read from the environment.
data Environment = Env
    { Environment -> Config
_config   :: Config
    -- ^ External configuration (colors, editor executable, …)

    , Environment -> Viewport
_viewport :: Viewport
    -- ^ The bounds (width and height) of the display viewport where the
    -- 'Vgrep.App.App' or the current 'Vgrep.Widget.Widget' is displayed
    } deriving (Environment -> Environment -> Bool
(Environment -> Environment -> Bool)
-> (Environment -> Environment -> Bool) -> Eq Environment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show)

makeLenses ''Environment


viewportHeight, viewportWidth :: Lens' Environment Int
viewportHeight :: (Int -> f Int) -> Environment -> f Environment
viewportHeight = (Viewport -> f Viewport) -> Environment -> f Environment
Lens' Environment Viewport
viewport ((Viewport -> f Viewport) -> Environment -> f Environment)
-> ((Int -> f Int) -> Viewport -> f Viewport)
-> (Int -> f Int)
-> Environment
-> f Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> Viewport -> f Viewport
Lens' Viewport Int
vpHeight
viewportWidth :: (Int -> f Int) -> Environment -> f Environment
viewportWidth  = (Viewport -> f Viewport) -> Environment -> f Environment
Lens' Environment Viewport
viewport ((Viewport -> f Viewport) -> Environment -> f Environment)
-> ((Int -> f Int) -> Viewport -> f Viewport)
-> (Int -> f Int)
-> Environment
-> f Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> Viewport -> f Viewport
Lens' Viewport Int
vpWidth