{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}

module IHaskell.Display.Widgets.Layout.Types where

import           Prelude hiding (Right,Left)

import           Control.Monad (unless)
import qualified Control.Exception as Ex

import           Data.List (intercalate)

import           Data.Vinyl (Rec(..))

import qualified IHaskell.Display.Widgets.Singletons as S
import           IHaskell.Display.Widgets.Types

import           IHaskell.Display.Widgets.Layout.Common

type LayoutClass = [ 'S.ModelModule
                   , 'S.ModelModuleVersion
                   , 'S.ModelName
                   , 'S.ViewModule
                   , 'S.ViewModuleVersion
                   , 'S.ViewName
                   , 'S.LAlignContent
                   , 'S.LAlignItems
                   , 'S.LAlignSelf
                   , 'S.LBorder
                   , 'S.LBottom
                   , 'S.LDisplay
                   , 'S.LFlex
                   , 'S.LFlexFlow
                   , 'S.LGridArea
                   , 'S.LGridAutoColumns
                   , 'S.LGridAutoFlow
                   , 'S.LGridAutoRows
                   , 'S.LGridColumn
                   , 'S.LGridGap
                   , 'S.LGridRow
                   , 'S.LGridTemplateAreas
                   , 'S.LGridTemplateColumns
                   , 'S.LGridTemplateRows
                   , 'S.LHeight
                   , 'S.LJustifyContent
                   , 'S.LJustifyItems
                   , 'S.LLeft
                   , 'S.LMargin
                   , 'S.LMaxHeight
                   , 'S.LMaxWidth
                   , 'S.LMinHeight
                   , 'S.LMinWidth
                   , 'S.LOrder
                   , 'S.LOverflow
                   , 'S.LOverflowX
                   , 'S.LOverflowY
                   , 'S.LPadding
                   , 'S.LRight
                   , 'S.LTop
                   , 'S.LVisibility
                   , 'S.LWidth
                   ]

type instance FieldType 'S.LAlignContent = Maybe String
type instance FieldType 'S.LAlignItems = Maybe String
type instance FieldType 'S.LAlignSelf = Maybe String
type instance FieldType 'S.LBorder = Maybe String
type instance FieldType 'S.LBottom = Maybe String
type instance FieldType 'S.LDisplay = Maybe String
type instance FieldType 'S.LFlex = Maybe String
type instance FieldType 'S.LFlexFlow = Maybe String
type instance FieldType 'S.LGridArea = Maybe String
type instance FieldType 'S.LGridAutoColumns = Maybe String
type instance FieldType 'S.LGridAutoFlow = Maybe String
type instance FieldType 'S.LGridAutoRows = Maybe String
type instance FieldType 'S.LGridColumn = Maybe String
type instance FieldType 'S.LGridGap = Maybe String
type instance FieldType 'S.LGridRow = Maybe String
type instance FieldType 'S.LGridTemplateAreas = Maybe String
type instance FieldType 'S.LGridTemplateColumns = Maybe String
type instance FieldType 'S.LGridTemplateRows = Maybe String
type instance FieldType 'S.LHeight = Maybe String
type instance FieldType 'S.LJustifyContent = Maybe String
type instance FieldType 'S.LJustifyItems = Maybe String
type instance FieldType 'S.LLeft = Maybe String
type instance FieldType 'S.LMargin = Maybe String
type instance FieldType 'S.LMaxHeight = Maybe String
type instance FieldType 'S.LMaxWidth = Maybe String
type instance FieldType 'S.LMinHeight = Maybe String
type instance FieldType 'S.LMinWidth = Maybe String
type instance FieldType 'S.LOrder = Maybe String
type instance FieldType 'S.LOverflow = Maybe String
type instance FieldType 'S.LOverflowX = Maybe String
type instance FieldType 'S.LOverflowY = Maybe String
type instance FieldType 'S.LPadding = Maybe String
type instance FieldType 'S.LRight = Maybe String
type instance FieldType 'S.LTop = Maybe String
type instance FieldType 'S.LVisibility = Maybe String
type instance FieldType 'S.LWidth = Maybe String

-- type family WidgetFields (w :: WidgetType) :: [Field] where
type instance WidgetFields 'LayoutType = LayoutClass

-- | A record representing a widget of the Layour class from IPython
defaultLayoutWidget :: Rec Attr LayoutClass
defaultLayoutWidget :: Rec Attr LayoutClass
defaultLayoutWidget = (SField 'ModelModule
S.SModelModule forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"@jupyter-widgets/base")
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SField 'ModelModuleVersion
S.SModelModuleVersion forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"1.1.0")
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SField 'ModelName
S.SModelName forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"LayoutModel")
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SField 'ViewModule
S.SViewModule forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"@jupyter-widgets/base")
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SField 'ViewModuleVersion
S.SViewModuleVersion forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"1.1.0")
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SField 'ViewName
S.SViewName forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:! Text
"LayoutView")
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LAlignContent) => SField a
AlignContent forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
alignContentProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LAlignItems) => SField a
AlignItems forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
alignItemProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LAlignSelf) => SField a
AlignSelf forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
alignSelfProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LBorder) => SField a
Border forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LBottom) => SField a
Bottom forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LDisplay) => SField a
Display forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LFlex) => SField a
Flex forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LFlexFlow) => SField a
FlexFlow forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridArea) => SField a
GridArea forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridAutoColumns) => SField a
GridAutoColumns forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridAutoFlow) => SField a
GridAutoFlow forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
gridAutoFlowProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridAutoRows) => SField a
GridAutoRows forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridColumn) => SField a
GridColumn forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridGap) => SField a
GridGap forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridRow) => SField a
GridRow forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridTemplateAreas) => SField a
GridTemplateAreas forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridTemplateColumns) => SField a
GridTemplateColumns forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LGridTemplateRows) => SField a
GridTemplateRows forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LHeight) => SField a
Height forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LJustifyContent) => SField a
JustifyContent forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LJustifyItems) => SField a
JustifyItems forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LLeft) => SField a
Left forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LMargin) => SField a
Margin forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LMaxHeight) => SField a
MaxHeight forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LMaxWidth) => SField a
MaxWidth forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LMinHeight) => SField a
MinHeight forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LMinWidth) => SField a
MinWidth forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LOrder) => SField a
Order forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LOverflow) => SField a
Overflow forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
overflowProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LOverflowX) => SField a
OverflowX forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
overflowProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LOverflowY) => SField a
OverflowY forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
overflowProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LPadding) => SField a
Padding forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LRight) => SField a
Right forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LTop) => SField a
Top forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LVisibility) => SField a
Visibility forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> (FieldType f, FieldType f -> IO (FieldType f)) -> Attr f
=:. (forall a. Maybe a
Nothing, [String] -> Maybe String -> IO (Maybe String)
venum [String]
visibilityProps))
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall {a :: Field}. (a ~ 'LWidth) => SField a
Width forall (f :: Field).
(SingI f, Typeable (FieldType f)) =>
Sing f -> FieldType f -> Attr f
=:: forall a. Maybe a
Nothing)
                      forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil
    where venum :: [String] -> Maybe String -> IO (Maybe String)
          venum :: [String] -> Maybe String -> IO (Maybe String)
venum [String]
_ Maybe String
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
          venum [String]
xs (Just String
f) = do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
xs) (forall a e. Exception e => e -> a
Ex.throw forall a b. (a -> b) -> a -> b
$ String -> AssertionFailed
Ex.AssertionFailed (String
"The value should be one of: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
xs))
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
f