module HSX.Layout (
Layout(..), IsLayout(..),
above, beside, (^^), (<>)
)where
import Prelude hiding ((^^))
import HSX.XMLGenerator
data Layoutm
= Above (Layout m) (Layout m)
| Beside (Layout m) (Layoutm)
| Item (GenChildList m)
class IsLayout m a where
toLayout :: a -> Layout m
instance IsLayout m (Layout m) where
toLayout = id
instance (EmbedAsChild m c) => IsLayout m c where
toLayout = Item . asChild
(^^),(<>),above,beside :: (IsLayout m a, IsLayout m b) =>a -> b -> Layout m
a ^^ b = Above (toLayout a) (toLayout b)
a <> b = Beside (toLayout a) (toLayout b)
above = (^^)
beside = (<>)
instance XMLGenerator m => EmbedAsChild m (Layout m) where
asChild a@(Above _ _) = asChild $
<table border="0"><% mapM mkRow $ foldAbove a %></table>
asChild b@(Beside _ _) = asChild $
<table border="0"><tr><% mapM mkCell $ foldBeside b %></tr></table>
asChild (Item xml) = xml
foldAbove :: Layout m -> [Layout m]
foldAbove (Above a b) = foldAbove a ++ foldAbove b
foldAbove l = [l]
foldBeside :: Layout m -> [Layout m]
foldBeside (Beside a b) = foldBeside a ++ foldBeside b
foldBeside l = [l]
mkRow :: (XMLGenerator m, EmbedAsChild m c) => c -> GenXML m
mkRow xml = <tr><% mkCell xml %></tr>
mkCell :: (XMLGenerator m, EmbedAsChild m c) => c -> GenXML m
mkCell xml = <td><% xml %></td>