Flexbox.hs

module Graphics.UI.Threepenny.Ext.Flexbox (
  -- * Parent Properties
  ParentProps (..), parentProps,

  -- * Child Properties
  ChildProps (..), childProps,

  -- * Core Functions
  flexbox, setProps, toStyle,

  -- * Helper functions
  column, row
  ) where

import qualified Clay.Common                 as CC
import           Clay.Display                (Display)
import qualified Clay.Display                as CD
import           Clay.Flexbox                (AlignContentValue,
                                              AlignItemsValue, AlignSelfValue,
                                              FlexDirection, FlexWrap,
                                              JustifyContentValue)
import qualified Clay.Flexbox                as CF
import           Clay.Property               (unKeys, unPlain, unValue)
import           Clay.Size                   (LengthUnit, Size)
import           Clay.Stylesheet             (Rule (Property), runS)
import           Data.Text                   (unpack)
import qualified Graphics.UI.Threepenny      as UI
import           Graphics.UI.Threepenny.Core hiding (column, row)

-- |Convert to Threepenny style.
class ToStyle a where
  toStyle :: a -> [(String, String)]

-- |Convert a Clay Property to Threepnny style.
instance ToStyle Rule where
  toStyle (Property k v) =
    [(unpack $ unPlain $ unKeys k, unpack $ unPlain $ unValue v)]

-- |Properties for a parent.
data ParentProps = ParentProps {
    pDisplay        :: Display
  , pFlexDirection  :: FlexDirection
  , pFlexWrap       :: FlexWrap
  , pJustifyContent :: JustifyContentValue
  , pAlignItems     :: AlignItemsValue
  , pAlignContent   :: AlignContentValue
}

-- |Convert parent properties to Threepenny style.
instance ToStyle ParentProps where
  toStyle p = concatMap toStyle $ concatMap runS [
        CD.display        $ pDisplay        p
      , CF.flexDirection  $ pFlexDirection  p
      , CF.flexWrap       $ pFlexWrap       p
      , CF.justifyContent $ pJustifyContent p
      , CF.alignItems     $ pAlignItems     p
      , CF.alignContent   $ pAlignContent   p
    ]

-- |Default properties for a parent.
parentProps :: ParentProps
parentProps = ParentProps {
    pDisplay        = CD.flex
  , pFlexDirection  = CF.row
  , pFlexWrap       = CF.nowrap
  , pJustifyContent = CF.flexStart
  , pAlignItems     = CF.stretch
  , pAlignContent   = CF.stretch
}

-- |Properties for a child.
data ChildProps = ChildProps {
    cOrder      :: Int
  , cFlexGrow   :: Int
  , cFlexShrink :: Int
  , cFlexBasis  :: Size LengthUnit
  , cAlignSelf  :: AlignSelfValue
}

-- |Convert child properties to Threepenny style.
instance ToStyle ChildProps where
  toStyle c = concatMap toStyle $ concatMap runS [
        CF.order      $ cOrder      c
      , CF.flexGrow   $ cFlexGrow   c
      , CF.flexShrink $ cFlexShrink c
      , CF.flexBasis  $ cFlexBasis  c
      , CF.alignSelf  $ cAlignSelf  c
    ]

-- |Default properties for a child.
childProps :: ChildProps
childProps = ChildProps {
    cOrder      = 1
  , cFlexGrow   = 0
  , cFlexShrink = 1
  , cFlexBasis  = CC.auto
  , cAlignSelf  = CC.auto
}

-- |Set Flexbox properties on an element.
setProps :: ToStyle a => UI Element -> a -> UI Element
setProps el props = el # set UI.style (toStyle props)

-- |Attach elements to a parent element, with given Flexbox properties applied.
flexbox ::
     UI Element                 -- ^ Parent
  -> ParentProps                -- ^ Parent Flexbox properties
  -> [(UI Element, ChildProps)] -- ^ Children and respective Flexbox properties
  -> UI Element                 -- ^ Parent with attached children
flexbox p pProps cs = do
  p'  <- setProps p pProps
  cs' <- mapM (uncurry setProps) cs
  element p' #+ map element cs'

-- |Attach elements to a parent element with flex-direction column.
column :: UI Element -> [UI Element] -> UI Element
column p cs = flexbox p parentProps { pFlexDirection = CF.column } $
  zip cs $ repeat childProps

-- |Attach elements to a parent element with default Flexbox properties.
row :: UI Element -> [UI Element] -> UI Element
row p cs = flexbox p parentProps $ zip cs $ repeat childProps