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

-- |
-- Module      : FULE.Container.Sized
-- Description : The @Sized@ Container.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- A 'FULE.Conatiner.Container' to specify or override the (inherent) size of
-- content.
--
-- To /remove/ the size of content from consideration during the layout process
-- see the 'FULE.Container.Unreckoned.Unreckoned' container.
module FULE.Container.Sized
 ( Sized
 , sizedHoriz
 , sizedVert
 , sized
 ) where

import Control.Applicative

import FULE.Container


-- | A container which specifies or overrides the size of content in the layout.
data Sized c
  = Sized
    { forall c. Sized c -> Maybe Int
widthOf :: Maybe Int
    , forall c. Sized c -> Maybe Int
heightOf :: Maybe Int
    , forall c. Sized c -> c
contentsOf :: c
    }

instance (Container c k m) => Container (Sized c) k m where
  minWidth :: Sized c -> Proxy k -> m (Maybe Int)
minWidth (Sized Maybe Int
w Maybe Int
_ c
c) Proxy k
p = (Maybe Int
w Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) (Maybe Int -> Maybe Int) -> m (Maybe Int) -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minWidth c
c Proxy k
p
  minHeight :: Sized c -> Proxy k -> m (Maybe Int)
minHeight (Sized Maybe Int
_ Maybe Int
h c
c) Proxy k
p = (Maybe Int
h Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) (Maybe Int -> Maybe Int) -> m (Maybe Int) -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
minHeight c
c Proxy k
p
  addToLayout :: Sized c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout (Sized Maybe Int
_ Maybe Int
_ c
c) = 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

-- | Add or override the horizontal size of the content.
sizedHoriz
  :: Int -- ^ The width the content should have.
  -> c -- ^ The content.
  -> Sized c
sizedHoriz :: forall c. Int -> c -> Sized c
sizedHoriz Int
width = Maybe Int -> Maybe Int -> c -> Sized c
forall c. Maybe Int -> Maybe Int -> c -> Sized c
Sized (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
width) Maybe Int
forall a. Maybe a
Nothing

-- | Add or override the vertical size of the content.
sizedVert
  :: Int -- ^ The height the content should have.
  -> c -- ^ The content.
  -> Sized c
sizedVert :: forall c. Int -> c -> Sized c
sizedVert Int
height = Maybe Int -> Maybe Int -> c -> Sized c
forall c. Maybe Int -> Maybe Int -> c -> Sized c
Sized Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
height)

-- | Add or override the size of the content in both dimensions.
sized
  :: (Int, Int) -- ^ The width and height the content should have.
  -> c -- ^ The content.
  -> Sized c
sized :: forall c. (Int, Int) -> c -> Sized c
sized (Int
width, Int
height) = Maybe Int -> Maybe Int -> c -> Sized c
forall c. Maybe Int -> Maybe Int -> c -> Sized c
Sized (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
width) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
height)