rearrange modules

Previously, the brick-specific Location type had been moved from
Brick.Types.Internal into the new BorderMap module. It's a bit of an odd
place to define it. So now there's an internal internal module named
Brick.Types.Common with a few things that BorderMap needs but that don't
really make sense to define inside the BorderMap module. Both BorderMap
and Types.Internal import this new Common module.
This commit is contained in:
Daniel Wagner 2018-03-21 12:07:59 -04:00
parent 2975cb9156
commit ec54d28d4b
7 changed files with 72 additions and 58 deletions

View File

@ -62,6 +62,7 @@ library
Brick
Brick.AttrMap
Brick.BChan
Brick.BorderMap
Brick.Focus
Brick.Forms
Brick.Main
@ -77,10 +78,10 @@ library
Brick.Widgets.Edit
Brick.Widgets.List
Brick.Widgets.ProgressBar
Data.BorderMap
Data.IMap
Data.Text.Markup
other-modules:
Brick.Types.Common
Brick.Types.TH
Brick.Types.Internal
Brick.Widgets.Internal

View File

@ -1,9 +1,8 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.BorderMap
module Brick.BorderMap
( BorderMap
, Location(..), origin, locL
, Edges(..)
, eTopL, eBottomL, eRightL, eLeftL
, empty, emptyCoordinates, singleton
@ -16,57 +15,12 @@ module Data.BorderMap
, translate
) where
import Brick.Types.TH (suffixLenses)
import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin)
import Control.Applicative (liftA2)
import qualified Data.Semigroup as Sem
import Data.IMap (IMap, Run(Run))
import Lens.Micro (_1, _2)
import Lens.Micro.Internal (Field1, Field2)
import Prelude hiding (lookup)
import qualified Data.IMap as IM
-- | A terminal screen location.
data Location = Location { loc :: (Int, Int)
-- ^ (Column, Row)
}
deriving (Show, Eq, Ord)
suffixLenses ''Location
instance Field1 Location Location Int Int where
_1 = locL._1
instance Field2 Location Location Int Int where
_2 = locL._2
-- | The origin (upper-left corner).
origin :: Location
origin = Location (0, 0)
instance Sem.Semigroup Location where
(Location (w1, h1)) <> (Location (w2, h2)) = Location (w1+w2, h1+h2)
instance Monoid Location where
mempty = origin
mappend = (Sem.<>)
data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }
deriving (Eq, Ord, Read, Show, Functor)
suffixLenses ''Edges
instance Applicative Edges where
pure a = Edges a a a a
Edges ft fb fl fr <*> Edges vt vb vl vr =
Edges (ft vt) (fb vb) (fl vl) (fr vr)
instance Monad Edges where
Edges vt vb vl vr >>= f = Edges
(eTop (f vt))
(eBottom (f vb))
(eLeft (f vl))
(eRight (f vr))
-- | Internal use only.
neighbors :: Edges a -> Edges (a, a)
neighbors (Edges vt vb vl vr) = Edges horiz horiz vert vert where

58
src/Brick/Types/Common.hs Normal file
View File

@ -0,0 +1,58 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
module Brick.Types.Common
( Location(..)
, locL
, origin
, Edges(..)
, eTopL, eBottomL, eRightL, eLeftL
) where
import Brick.Types.TH (suffixLenses)
import qualified Data.Semigroup as Sem
import Lens.Micro (_1, _2)
import Lens.Micro.Internal (Field1, Field2)
-- | A terminal screen location.
data Location = Location { loc :: (Int, Int)
-- ^ (Column, Row)
}
deriving (Show, Eq, Ord)
suffixLenses ''Location
instance Field1 Location Location Int Int where
_1 = locL._1
instance Field2 Location Location Int Int where
_2 = locL._2
-- | The origin (upper-left corner).
origin :: Location
origin = Location (0, 0)
instance Sem.Semigroup Location where
(Location (w1, h1)) <> (Location (w2, h2)) = Location (w1+w2, h1+h2)
instance Monoid Location where
mempty = origin
mappend = (Sem.<>)
data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }
deriving (Eq, Ord, Read, Show, Functor)
suffixLenses ''Edges
instance Applicative Edges where
pure a = Edges a a a a
Edges ft fb fl fr <*> Edges vt vb vl vr =
Edges (ft vt) (fb vb) (fl vl) (fr vr)
instance Monad Edges where
Edges vt vb vl vr >>= f = Edges
(eTop (f vt))
(eBottom (f vb))
(eLeft (f vl))
(eRight (f vr))

View File

@ -53,14 +53,15 @@ where
import Data.Monoid
#endif
import Data.BorderMap (BorderMap, Edges(..), Location(..), locL, origin, eTopL, eBottomL, eLeftL, eRightL)
import qualified Data.BorderMap as BM
import Lens.Micro (_1, _2, Lens')
import Lens.Micro.TH (makeLenses)
import qualified Data.Set as S
import qualified Data.Map as M
import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, Attr, emptyImage)
import Brick.BorderMap (BorderMap)
import qualified Brick.BorderMap as BM
import Brick.Types.Common
import Brick.Types.TH
import Brick.AttrMap (AttrName, AttrMap)
import Brick.Widgets.Border.Style (BorderStyle)

View File

@ -39,7 +39,7 @@ import Brick.Widgets.Core
import Brick.Widgets.Border.Style (BorderStyle(..))
import Brick.Widgets.Internal (renderDynBorder)
import Data.IMap (Run(..))
import qualified Data.BorderMap as BM
import qualified Brick.BorderMap as BM
-- | The top-level border attribute name.
borderAttr :: AttrName
@ -107,7 +107,7 @@ hBorder =
let bs = ctxBorderStyle ctx
w = availWidth ctx
db <- dynBorderFromDirections (Edges False False True True)
let dynBorders = BM.insertH BM.origin (Run w db)
let dynBorders = BM.insertH mempty (Run w db)
$ BM.emptyCoordinates (Edges 0 0 0 (w-1))
setDynBorders dynBorders $ render $ vLimit 1 $ fill (bsHorizontal bs)
@ -129,7 +129,7 @@ vBorder =
let bs = ctxBorderStyle ctx
h = availHeight ctx
db <- dynBorderFromDirections (Edges True True False False)
let dynBorders = BM.insertV BM.origin (Run h db)
let dynBorders = BM.insertV mempty (Run h db)
$ BM.emptyCoordinates (Edges 0 (h-1) 0 0)
setDynBorders dynBorders $ render $ hLimit 1 $ fill (bsVertical bs)
@ -165,5 +165,5 @@ joinableBorder :: Edges Bool -> Widget n
joinableBorder dirs = withAttr borderAttr . Widget Fixed Fixed $ do
db <- dynBorderFromDirections dirs
setDynBorders
(BM.singleton BM.origin db)
(BM.singleton mempty db)
(render (raw (renderDynBorder db)))

View File

@ -108,7 +108,6 @@ import qualified Data.DList as DL
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IMap as I
import qualified Data.BorderMap as BM
import qualified Data.Function as DF
import Data.List (sortBy, partition)
import qualified Graphics.Vty as V
@ -122,6 +121,7 @@ import Brick.Widgets.Border.Style
import Brick.Util (clOffset, clamp)
import Brick.AttrMap
import Brick.Widgets.Internal
import qualified Brick.BorderMap as BM
-- | The class of text types that have widths measured in terminal
-- columns. NEVER use 'length' etc. to measure the length of a string if

View File

@ -21,8 +21,8 @@ import Brick.Types
import Brick.Types.Internal
import Brick.AttrMap
import Brick.Widgets.Border.Style
import Data.BorderMap (BorderMap, Edges(..))
import qualified Data.BorderMap as BM
import Brick.BorderMap (BorderMap, Edges(..))
import qualified Brick.BorderMap as BM
renderFinal :: AttrMap
-> [Widget n]