{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- There are lots of pattern synpnyms, and little would be gained by adding
-- the type signatures.
{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module IHaskell.Display.Widgets.Layout.Common where

import qualified IHaskell.Display.Widgets.Singletons as S

pattern $bAlignContent :: forall {a :: Field}. (a ~ 'LAlignContent) => SField a
$mAlignContent :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LAlignContent) => r) -> ((# #) -> r) -> r
AlignContent = S.SLAlignContent
pattern $bAlignItems :: forall {a :: Field}. (a ~ 'LAlignItems) => SField a
$mAlignItems :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LAlignItems) => r) -> ((# #) -> r) -> r
AlignItems = S.SLAlignItems
pattern $bAlignSelf :: forall {a :: Field}. (a ~ 'LAlignSelf) => SField a
$mAlignSelf :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LAlignSelf) => r) -> ((# #) -> r) -> r
AlignSelf = S.SLAlignSelf
pattern $bBorder :: forall {a :: Field}. (a ~ 'LBorder) => SField a
$mBorder :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LBorder) => r) -> ((# #) -> r) -> r
Border = S.SLBorder
pattern $bBottom :: forall {a :: Field}. (a ~ 'LBottom) => SField a
$mBottom :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LBottom) => r) -> ((# #) -> r) -> r
Bottom = S.SLBottom
pattern $bDisplay :: forall {a :: Field}. (a ~ 'LDisplay) => SField a
$mDisplay :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LDisplay) => r) -> ((# #) -> r) -> r
Display = S.SLDisplay
pattern $bFlex :: forall {a :: Field}. (a ~ 'LFlex) => SField a
$mFlex :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LFlex) => r) -> ((# #) -> r) -> r
Flex = S.SLFlex
pattern $bFlexFlow :: forall {a :: Field}. (a ~ 'LFlexFlow) => SField a
$mFlexFlow :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LFlexFlow) => r) -> ((# #) -> r) -> r
FlexFlow = S.SLFlexFlow
pattern $bGridArea :: forall {a :: Field}. (a ~ 'LGridArea) => SField a
$mGridArea :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridArea) => r) -> ((# #) -> r) -> r
GridArea = S.SLGridArea
pattern $bGridAutoColumns :: forall {a :: Field}. (a ~ 'LGridAutoColumns) => SField a
$mGridAutoColumns :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridAutoColumns) => r) -> ((# #) -> r) -> r
GridAutoColumns = S.SLGridAutoColumns
pattern $bGridAutoFlow :: forall {a :: Field}. (a ~ 'LGridAutoFlow) => SField a
$mGridAutoFlow :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridAutoFlow) => r) -> ((# #) -> r) -> r
GridAutoFlow = S.SLGridAutoFlow
pattern $bGridAutoRows :: forall {a :: Field}. (a ~ 'LGridAutoRows) => SField a
$mGridAutoRows :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridAutoRows) => r) -> ((# #) -> r) -> r
GridAutoRows = S.SLGridAutoRows
pattern $bGridColumn :: forall {a :: Field}. (a ~ 'LGridColumn) => SField a
$mGridColumn :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridColumn) => r) -> ((# #) -> r) -> r
GridColumn = S.SLGridColumn
pattern $bGridGap :: forall {a :: Field}. (a ~ 'LGridGap) => SField a
$mGridGap :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridGap) => r) -> ((# #) -> r) -> r
GridGap = S.SLGridGap
pattern $bGridRow :: forall {a :: Field}. (a ~ 'LGridRow) => SField a
$mGridRow :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridRow) => r) -> ((# #) -> r) -> r
GridRow = S.SLGridRow
pattern $bGridTemplateAreas :: forall {a :: Field}. (a ~ 'LGridTemplateAreas) => SField a
$mGridTemplateAreas :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridTemplateAreas) => r) -> ((# #) -> r) -> r
GridTemplateAreas = S.SLGridTemplateAreas
pattern $bGridTemplateColumns :: forall {a :: Field}. (a ~ 'LGridTemplateColumns) => SField a
$mGridTemplateColumns :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridTemplateColumns) => r) -> ((# #) -> r) -> r
GridTemplateColumns = S.SLGridTemplateColumns
pattern $bGridTemplateRows :: forall {a :: Field}. (a ~ 'LGridTemplateRows) => SField a
$mGridTemplateRows :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LGridTemplateRows) => r) -> ((# #) -> r) -> r
GridTemplateRows = S.SLGridTemplateRows
pattern $bHeight :: forall {a :: Field}. (a ~ 'LHeight) => SField a
$mHeight :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LHeight) => r) -> ((# #) -> r) -> r
Height = S.SLHeight
pattern $bJustifyContent :: forall {a :: Field}. (a ~ 'LJustifyContent) => SField a
$mJustifyContent :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LJustifyContent) => r) -> ((# #) -> r) -> r
JustifyContent = S.SLJustifyContent
pattern $bJustifyItems :: forall {a :: Field}. (a ~ 'LJustifyItems) => SField a
$mJustifyItems :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LJustifyItems) => r) -> ((# #) -> r) -> r
JustifyItems = S.SLJustifyItems
pattern $bLeft :: forall {a :: Field}. (a ~ 'LLeft) => SField a
$mLeft :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LLeft) => r) -> ((# #) -> r) -> r
Left = S.SLLeft
pattern $bMargin :: forall {a :: Field}. (a ~ 'LMargin) => SField a
$mMargin :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LMargin) => r) -> ((# #) -> r) -> r
Margin = S.SLMargin
pattern $bMaxHeight :: forall {a :: Field}. (a ~ 'LMaxHeight) => SField a
$mMaxHeight :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LMaxHeight) => r) -> ((# #) -> r) -> r
MaxHeight = S.SLMaxHeight
pattern $bMaxWidth :: forall {a :: Field}. (a ~ 'LMaxWidth) => SField a
$mMaxWidth :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LMaxWidth) => r) -> ((# #) -> r) -> r
MaxWidth = S.SLMaxWidth
pattern $bMinHeight :: forall {a :: Field}. (a ~ 'LMinHeight) => SField a
$mMinHeight :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LMinHeight) => r) -> ((# #) -> r) -> r
MinHeight = S.SLMinHeight
pattern $bMinWidth :: forall {a :: Field}. (a ~ 'LMinWidth) => SField a
$mMinWidth :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LMinWidth) => r) -> ((# #) -> r) -> r
MinWidth = S.SLMinWidth
pattern $bOrder :: forall {a :: Field}. (a ~ 'LOrder) => SField a
$mOrder :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LOrder) => r) -> ((# #) -> r) -> r
Order = S.SLOrder
pattern $bOverflow :: forall {a :: Field}. (a ~ 'LOverflow) => SField a
$mOverflow :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LOverflow) => r) -> ((# #) -> r) -> r
Overflow = S.SLOverflow
pattern $bOverflowX :: forall {a :: Field}. (a ~ 'LOverflowX) => SField a
$mOverflowX :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LOverflowX) => r) -> ((# #) -> r) -> r
OverflowX = S.SLOverflowX
pattern $bOverflowY :: forall {a :: Field}. (a ~ 'LOverflowY) => SField a
$mOverflowY :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LOverflowY) => r) -> ((# #) -> r) -> r
OverflowY = S.SLOverflowY
pattern $bPadding :: forall {a :: Field}. (a ~ 'LPadding) => SField a
$mPadding :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LPadding) => r) -> ((# #) -> r) -> r
Padding = S.SLPadding
pattern $bRight :: forall {a :: Field}. (a ~ 'LRight) => SField a
$mRight :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LRight) => r) -> ((# #) -> r) -> r
Right = S.SLRight
pattern $bTop :: forall {a :: Field}. (a ~ 'LTop) => SField a
$mTop :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LTop) => r) -> ((# #) -> r) -> r
Top = S.SLTop
pattern $bVisibility :: forall {a :: Field}. (a ~ 'LVisibility) => SField a
$mVisibility :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LVisibility) => r) -> ((# #) -> r) -> r
Visibility = S.SLVisibility
pattern $bWidth :: forall {a :: Field}. (a ~ 'LWidth) => SField a
$mWidth :: forall {r} {a :: Field}.
SField a -> ((a ~ 'LWidth) => r) -> ((# #) -> r) -> r
Width = S.SLWidth

-- TODO: This should be implemented with static type checking, so it's
-- easier to verify at compile-time. "The Haskell Way".
-- But a lot of these fields have common values. ¿Maybe doing some kind
-- of singleton for the CSS fields? ¿Maybe appending the type like
-- InheritOverflow / InheritVisible / InheritGrid...
-- In the meantime we'll use arrays of strings and some runtime verification
cssProps :: [String]
cssProps :: [String]
cssProps = [String
"inherit", String
"initial", String
"unset"]
alignContentProps :: [String]
alignContentProps = [String
"flex-start", String
"flex-end", String
"center", String
"space-between", String
"space-around", String
"space-evenly", String
"stretch"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps
alignItemProps :: [String]
alignItemProps =  [String
"flex-start", String
"flex-end", String
"center", String
"baseline", String
"stretch"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps
alignSelfProps :: [String]
alignSelfProps = [String
"auto", String
"flex-start", String
"flex-end", String
"center", String
"baseline", String
"stretch"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps
gridAutoFlowProps :: [String]
gridAutoFlowProps = [String
"column", String
"row", String
"row dense", String
"column dense"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps
justifyContentProps :: [String]
justifyContentProps = [String
"flex-start", String
"flex-end", String
"center", String
"space-between", String
"space-around"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps
justifyItemsProps :: [String]
justifyItemsProps = [String
"flex-start", String
"flex-end", String
"center"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps
overflowProps :: [String]
overflowProps = [String
"visible", String
"hidden", String
"scroll", String
"auto"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps
visibilityProps :: [String]
visibilityProps = [String
"visible", String
"hidden"] forall a. [a] -> [a] -> [a]
++ [String]
cssProps