{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} module Grafana.Layout where import Data.Bifunctor import Data.Foldable data Pos = Pos !Int !Int deriving (Eq, Show) data Rect = Rect { left :: !Int , right :: !Int , top :: !Int , bottom :: !Int } deriving (Eq, Show) instance Semigroup Rect where Rect l r t b <> Rect l' r' t' b' = Rect (min l l') (max r r') (min t t') (max b b') data Layout a = Layout [(Rect, a)] Rect | Empty deriving (Eq, Show, Functor) instance Semigroup (Layout a) where Layout ars ab <> Layout brs bb = Layout (ars <> brs) (ab <> bb) a <> Empty = a Empty <> a = a instance Monoid (Layout a) where mempty = Empty moveLayout :: Pos -> Layout a -> Layout a moveLayout _ Empty = Empty moveLayout p (Layout xs rect) = Layout (map (first (moveRect p)) xs) (moveRect p rect) moveRect :: Pos -> Rect -> Rect moveRect (Pos x y) (Rect l r t b) = Rect (l + x) (r + x) (t + y) (b + y) atop :: Layout a -> Layout a -> Layout a atop a b = a <> moveLayout (Pos 0 (bottoml a)) b nextTo :: Layout a -> Layout a -> Layout a nextTo a b = a <> moveLayout (Pos (rightl a) 0) b rightl :: Layout a -> Int rightl Empty = 0 rightl (Layout _ r) = right r bottoml :: Layout a -> Int bottoml Empty = 0 bottoml (Layout _ r) = bottom r rowFits :: Int -> Int -> Int -> [Rect] rowFits maxWidth itemCount rowHeight = fmap (\x -> Rect x (x+width) 0 rowHeight) xs where xs = [padding, width + padding..] width = maxWidth `div` itemCount padding = maxWidth `mod` itemCount `div` 2 fitToRow :: Int -> Int -> [Rect -> Layout a] -> Layout a fitToRow maxWidth rowHeight items = fold $ zipWith ($) items (rowFits maxWidth (length items) rowHeight) fillRows :: Int -> Int -> Int -> [Rect -> Layout a] -> Layout a fillRows maxWidth rowHeight cols items | null thisRow = Empty | otherwise = fold (zipWith ($) thisRow (rowFits maxWidth cols rowHeight)) `atop` fillRows maxWidth rowHeight cols rest where (thisRow, rest) = splitAt cols items