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

-- |
-- Module      : FULE.Container.Clipped
-- Description : The @Clipped@ Container.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- A 'FULE.Container.Container' to specify that content overflow should be clipped.
module FULE.Container.Clipped
 ( Clipped
 , clipped
 ) where

import FULE.Component
import FULE.Container


-- | A container the content of which should be clipped on overflow.
--   Clipping bounds are specified as part of 'FULE.Component.Bounds' of
--   contained 'FULE.Component.Component's.
--
--   It is up to you the consumer to implement the actual clipping of content.
newtype Clipped c = Clipped c

instance (Container c k m) => Container (Clipped c) k m where
  minWidth :: Clipped c -> Proxy k -> m (Maybe Int)
minWidth (Clipped c
c) = c -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minWidth c
c
  minHeight :: Clipped c -> Proxy k -> m (Maybe Int)
minHeight (Clipped c
c) = c -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minHeight c
c
  addToLayout :: Clipped c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout (Clipped c
c) Proxy k
proxy Bounds
bounds =
    c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout c
c Proxy k
proxy Bounds
bounds{ clippingOf = Just bounds }

-- | Create a container which clips any overflow.
clipped :: c -> Clipped c
clipped :: forall c. c -> Clipped c
clipped = c -> Clipped c
forall c. c -> Clipped c
Clipped