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

-- |
-- Module      : FULE.Container.Item
-- Description : Wrapper for heterogenous content.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- A wrapper for heterogenous content to be used by other
-- `FULE.Container.Container's.
module FULE.Container.Item
 ( ItemM
 , Item
 , item
 ) where

import Data.Functor.Identity

import FULE.Container


-- | A container for heterogenous items. This container lets items of different
--   types be used in the same aggregating container, like
--   'FULE.Container.Arrayed.ArrayedM', 'FULE.Container.Grid.GridM', or
--   'FULE.Container.Layered.LayeredM'.
--
--   When using @ItemM@ you'll likely need to:
--   
--   * Use the [@ScopedTypeVariables@](https://wiki.haskell.org/Scoped_type_variables)
--     language extension and explicitly specify a @forall m@ in your
--     function declaration (if a type-variable is being used)
--   * Explicitly specify the type of your list of @ItemM@ in the call to the
--     aggregating container and wrap the list in parentheses
--
--   For example:
--
-- > {-# LANGUAGE ScopedTypeVariables #-}
-- >
-- > import FULE
-- >
-- > ...
-- >
-- > someFn :: forall m => m (ArrayedM m Widget)
-- > someFn = return $
-- >   arrayedHoriz noPadding
-- >     ([item someWidget
-- >     , item someContainer
-- >     , item someOtherWidget
-- >     ]::[ItemM m Widget])
--
--   [Reference: Heterogenous Collections](https://wiki.haskell.org/Heterogenous_collections)
data ItemM m k = forall c . Container c k m => Item c

-- | Like 'ItemM' but run in the 'Data.Functor.Identity.Identity' monad.
type Item = ItemM Identity

instance (Monad m) => Container (ItemM m k) k m where
  minWidth :: ItemM m k -> Proxy k -> m (Maybe Int)
minWidth (Item 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 :: ItemM m k -> Proxy k -> m (Maybe Int)
minHeight (Item 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 :: ItemM m k -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout (Item 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

-- | Create an 'ItemM' with a heterogenous item.
item :: (Container c k m) => c -> ItemM m k
item :: forall c k (m :: * -> *). Container c k m => c -> ItemM m k
item = c -> ItemM m k
forall (m :: * -> *) k c. Container c k m => c -> ItemM m k
Item