{-# LANGUAGE FlexibleContexts, AllowAmbiguousTypes, DataKinds, GADTs, RankNTypes, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-} module Bootstrap4.Layout where import Lucid as L import Lucid.Html5 as L import Data.Coerce import Lucid.Base import Data.Text.Internal.Lazy newtype Container m a = Container (HtmlT m a) newtype Row = Row {unRow :: Html ()} newtype Col = Col {unCol :: Html ()} -- type family ValidChild parent child where -- ValidChild Container Row = 'True -- ValidChild Container HtmlT = 'True -- ValidChild Row Col = 'True class ValidChild parent child where wrapChild :: child -> parent -- instance (Applicative m) => ValidChild Row where -- wrapChild cols = Row (div_ [ class_ " row " ] $ sequence $ (unCol <$> cols)) instance ValidChild Row Col where wrapChild col = Row (div_ [ class_ " row " ] $ unCol col) instance With (Col -> Row) where with fn attrs = \col -> Row $ with (unRow $ fn col) attrs instance With ([Col] -> Row) where with fn attrs = \inner -> Row $ with (unRow $ fn inner) attrs instance ValidChild Row [Col] where wrapChild cols = Row $ div_ [ class_ " row " ] $ mapM_ unCol cols -- container_ :: (With a) => a -> a -- container_ :: (ValidChild Container h ~ True, Term [Attribute] (h m a -> t2)) => h m a -> t2 -- container_ inner = div_ [ class_ "container" ] inner -- row_ :: forall h m a t2 . (ValidChild Row h ~ True, Term [Attribute] (h m a -> t2)) => h m a -> t2 -- row_ child = div_ [ class_ " row " ] (coerce child) -- row_ :: (Applicative m, ValidChild (Row m a) (x m a)) => x m a -> Row m a row_ col = (wrapChild col) -- row_ :: (ValidChild Row x) => x -> Row -- row_ x = wrapChild x -- runBootstrap :: (Applicative m) => Row -> -- runBootstrap (Row inner) = inner test :: Text test = renderText $ unRow $ do with row_ [ class_ " something "] [ Col (p_ "col1"), Col (p_ "col2") ]