{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : FULE.Component
-- Description : The @Component@ typeclass
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- A typeclass which any visual component made by you should implement;
-- related datatypes.
module FULE.Component
 ( Component(..)
 , ComponentInfo(..)
 , RenderGroup
 , Bounds(..)
 , HasBoundingGuides(..)
 , boundingGuidesInCSSOrderFor
 ) where

import Control.DeepSeq

import FULE.Layout


-- | A typeclass for specifying the display requirements of a visual component.
--
--   A default implementation has been provided meaning you may wish to have
--   your instances use the @{-# OVERLAPS #-}@ or @{-# OVERLAPPING #-}@ pragmas.
--
--   You'll need to have the @MultiParamTypeClasses@ language extension enabled
--   to implement this.
class (Monad m) => Component k m where
  -- | The /width/ the component requires on-screen, if any.
  --   The default implementation returns @Nothing@.
  requiredWidth :: k -> m (Maybe Int)
  requiredWidth k
_ = Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  -- | The /height/ the compnent requires on-screen, if any.
  --   The default implementation returns @Nothing@.
  requiredHeight :: k -> m (Maybe Int)
  requiredHeight k
_ = Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing

-- | A convenience instance for components that have no width or height
--   requirements.
instance {-# OVERLAPPABLE #-} (Monad m) => Component k m where


-- | Meta info about a component along with the component itself.
data ComponentInfo k
  = ComponentInfo
    { forall k. ComponentInfo k -> Bounds
boundsOf :: Bounds -- ^ The bounding rectangle of the component.
    , forall k. ComponentInfo k -> k
componentOf :: k -- ^ The component itself.
    , forall k. ComponentInfo k -> Maybe Int
renderGroupOf :: RenderGroup -- ^ The render group of the component.
    }
  deriving ((forall a b. (a -> b) -> ComponentInfo a -> ComponentInfo b)
-> (forall a b. a -> ComponentInfo b -> ComponentInfo a)
-> Functor ComponentInfo
forall a b. a -> ComponentInfo b -> ComponentInfo a
forall a b. (a -> b) -> ComponentInfo a -> ComponentInfo b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ComponentInfo a -> ComponentInfo b
fmap :: forall a b. (a -> b) -> ComponentInfo a -> ComponentInfo b
$c<$ :: forall a b. a -> ComponentInfo b -> ComponentInfo a
<$ :: forall a b. a -> ComponentInfo b -> ComponentInfo a
Functor, Int -> ComponentInfo k -> ShowS
[ComponentInfo k] -> ShowS
ComponentInfo k -> String
(Int -> ComponentInfo k -> ShowS)
-> (ComponentInfo k -> String)
-> ([ComponentInfo k] -> ShowS)
-> Show (ComponentInfo k)
forall k. Show k => Int -> ComponentInfo k -> ShowS
forall k. Show k => [ComponentInfo k] -> ShowS
forall k. Show k => ComponentInfo k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> ComponentInfo k -> ShowS
showsPrec :: Int -> ComponentInfo k -> ShowS
$cshow :: forall k. Show k => ComponentInfo k -> String
show :: ComponentInfo k -> String
$cshowList :: forall k. Show k => [ComponentInfo k] -> ShowS
showList :: [ComponentInfo k] -> ShowS
Show)

instance (NFData k) => NFData (ComponentInfo k) where
  rnf :: ComponentInfo k -> ()
rnf i :: ComponentInfo k
i@(ComponentInfo { boundsOf :: forall k. ComponentInfo k -> Bounds
boundsOf = Bounds
b, componentOf :: forall k. ComponentInfo k -> k
componentOf = k
k, renderGroupOf :: forall k. ComponentInfo k -> Maybe Int
renderGroupOf = Maybe Int
g }) =
    ComponentInfo k -> () -> ()
forall a b. a -> b -> b
seq ComponentInfo k
i (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bounds -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Bounds
b (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq k
k (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Maybe Int
g (() -> ()) -> () -> ()
forall a b. (a -> b) -> a -> b
$ ()


-- | A convenience type-wrapper representing the rendering group a component
--   is associated with. Rendering groups are tracked when multiple components
--   overlap (in the z-axis) or are part of containers which overlap.
--   (They are not used internally but are tracked as a convenience for the
--   consumer.)
type RenderGroup = Maybe Int


-- | A collection of Guides representing the bounding rectangle of a visual
--   component.
data Bounds
  = Bounds
    { Bounds -> GuideID
topOf :: GuideID
    -- ^ The Guide representing the /top/ edge of the bounding rectangle.
    , Bounds -> GuideID
leftOf :: GuideID
    -- ^ The Guide representing the /left/ edge of the bounding rectangle.
    , Bounds -> GuideID
rightOf :: GuideID
    -- ^ The Guide representing the /right/ edge of the bounding rectangle.
    , Bounds -> GuideID
bottomOf :: GuideID
    -- ^ The Guide representing the /bottom/ edge of the bounding rectangle.
    , Bounds -> Maybe Bounds
clippingOf :: Maybe Bounds
    -- ^ Another @Bounds@ which may cause this one to clip.
    }
  deriving (ReadPrec [Bounds]
ReadPrec Bounds
Int -> ReadS Bounds
ReadS [Bounds]
(Int -> ReadS Bounds)
-> ReadS [Bounds]
-> ReadPrec Bounds
-> ReadPrec [Bounds]
-> Read Bounds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Bounds
readsPrec :: Int -> ReadS Bounds
$creadList :: ReadS [Bounds]
readList :: ReadS [Bounds]
$creadPrec :: ReadPrec Bounds
readPrec :: ReadPrec Bounds
$creadListPrec :: ReadPrec [Bounds]
readListPrec :: ReadPrec [Bounds]
Read, Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bounds -> ShowS
showsPrec :: Int -> Bounds -> ShowS
$cshow :: Bounds -> String
show :: Bounds -> String
$cshowList :: [Bounds] -> ShowS
showList :: [Bounds] -> ShowS
Show)

instance NFData Bounds where
  rnf :: Bounds -> ()
rnf a :: Bounds
a@(Bounds GuideID
t GuideID
l GuideID
r GuideID
b Maybe Bounds
c) =
    Bounds -> () -> ()
forall a b. a -> b -> b
seq Bounds
a (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuideID -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq GuideID
t (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuideID -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq GuideID
l (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuideID -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq GuideID
r (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuideID -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq GuideID
b (() -> ()) -> (() -> ()) -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bounds -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq Maybe Bounds
c (() -> ()) -> () -> ()
forall a b. (a -> b) -> a -> b
$ ()


-- | A typeclass for retrieving Guides representing a bounding rectangle.
class HasBoundingGuides a where
  -- | Retrieves the bounding Guides for a type in the order:
  --   /top/, /left/, /right/, /bottom/.
  boundingGuidesFor :: Layout -> a -> [Int]

instance HasBoundingGuides Bounds where
  boundingGuidesFor :: Layout -> Bounds -> [Int]
boundingGuidesFor Layout
layout (Bounds GuideID
t GuideID
l GuideID
r GuideID
b Maybe Bounds
_) =
    [GuideID] -> Layout -> [Int]
getGuides [GuideID
t, GuideID
l, GuideID
r, GuideID
b] Layout
layout

instance HasBoundingGuides (ComponentInfo k) where
  boundingGuidesFor :: Layout -> ComponentInfo k -> [Int]
boundingGuidesFor Layout
layout ComponentInfo k
component =
    Layout -> Bounds -> [Int]
forall a. HasBoundingGuides a => Layout -> a -> [Int]
boundingGuidesFor Layout
layout (ComponentInfo k -> Bounds
forall k. ComponentInfo k -> Bounds
boundsOf ComponentInfo k
component)

-- | Retrieves the bounding Guides for a type in CSS-order:
--   /top/, /right/, /bottom/, /left/.
boundingGuidesInCSSOrderFor :: (HasBoundingGuides a) => Layout -> a -> [Int]
boundingGuidesInCSSOrderFor :: forall a. HasBoundingGuides a => Layout -> a -> [Int]
boundingGuidesInCSSOrderFor Layout
layout a
component =
  let [Int
t, Int
l, Int
r, Int
b] = Layout -> a -> [Int]
forall a. HasBoundingGuides a => Layout -> a -> [Int]
boundingGuidesFor Layout
layout a
component
  in [Int
t, Int
r, Int
b, Int
l]