module Text.YuiGrid.Grid where import Data.Maybe (fromJust, fromMaybe, catMaybes) import Data.List (partition, maximumBy, sortBy) import Control.Monad (mplus) import Data.Ord (comparing) import Text.YuiGrid.LayoutHints data GridNode a = Box a LayoutHints | Container [GridNode a] LayoutHints instance HasLayoutHints (GridNode a) where --modLayoutHints :: (LayoutHints -> LayoutHints) -> GridNode a -> GridNode a modLayoutHints f (Box x lhs) = Box x (f lhs) modLayoutHints f (Container gns lhs) = Container gns (f lhs) instance Functor GridNode where fmap f (Box x lhs) = Box (f x) lhs fmap f (Container gns lhs) = Container (map (fmap f) gns) lhs -- other hints that might be implemented in the future -- | ClearLeft | ClearRight | MinHeight Int | MaxHeight Int | MinWidth Int | MaxWidth Int layoutHints :: GridNode a -> LayoutHints layoutHints (Box _ lhs) = lhs layoutHints (Container _ lhs) = lhs addChildren :: GridNode a -> [GridNode a] -> GridNode a addChildren gn [] = gn addChildren (Container gns lhs) gns' = Container (gns ++gns') lhs addChildren (Box x lhs) gns' = Container (toBox x : gns') lhs ----------------------------- -- in first sibling --------- ----------------------------- moveSiblings :: [GridNode a] -> [GridNode a] moveSiblings [] = [] moveSiblings (gn:gns) = moveSiblings' (resetInFstSibling gn) gns moveSiblings' :: GridNode a -> [GridNode a] -> [GridNode a] moveSiblings' gn gns = addChildren gn (map resetInFstSibling toBeMovedGns) : notToBeMovedGns where (toBeMovedGns, notToBeMovedGns) = partition (inFstSibling . layoutHints) gns ----------------------------- -- page area calculation ---- ----------------------------- gridNodesByPageArea :: [GridNode a] -> ( [GridNode a], -- inMain nodes [GridNode a], -- inHeader nodes [GridNode a], -- inFooter nodes [GridNode a], -- inLeftSidebar nodes [GridNode a] -- inRightSidebar nodes ) gridNodesByPageArea gns = ( lookupGridNodes InMain, lookupGridNodes InHeader, lookupGridNodes InFooter, lookupGridNodes InLeftSidebar, lookupGridNodes InRightSidebar ) where --lookupGridNodes :: PageAreaHint -> [GridNode a] lookupGridNodes hint = fromMaybe [] (lookup hint classifiedGridNodes) --classifiedGridNodes :: [(PageAreaHint,[GridNode a])] classifiedGridNodes = partitionByEq pageArea gns pageArea :: GridNode a -> PageAreaHint pageArea = (fromMaybe InMain) . pageAreaHint' pageAreaHint' :: GridNode a -> Maybe PageAreaHint pageAreaHint' (Box _ lhs) = pageAreaHint lhs pageAreaHint' (Container gns lhs) = pageAreaHint lhs `mplus` (occurresMost . catMaybes . map pageAreaHint') gns ----------------------------------- -- vertical layout calculation ---- ----------------------------------- -- must be applied to all containers, not just top level containers. It is not recursive. gridNodesVerticalPartitions :: [GridNode a] -> [[GridNode a]] gridNodesVerticalPartitions = map snd . sortByFst . partitionByEq (verticalHint . layoutHints) . moveSiblings ------------------------------------------ -- columns and clearsides calculation ---- ------------------------------------------ splitClearSides :: [[GridNode a]] -> [[GridNode a]] splitClearSides = splitTruesAlone ((==ClearSides) . horizontalHint . layoutHints) splitTruesAlone :: (a->Bool) -> [[a]] -> [[a]] splitTruesAlone f = concat . map (splitTruesAlone' f) {- [[top], [bot]] [[[topCs1],[topCs2],[topothers]], [[botCs1],[botCs2],[botothers]] ] [[topCs1],[topCs2],[topothers], [botCs1],[botCs2],[botothers] ] -} splitTruesAlone' :: (a->Bool) -> [a] -> [[a]] splitTruesAlone' f gns = case withFalse of [] -> withTrueLists _ -> withTrueLists ++ [withFalse] where (withTrue, withFalse) = partition f gns withTrueLists = map (:[]) withTrue gridNodesByColumns :: Maybe Int -> [GridNode a] -> [[GridNode a]] gridNodesByColumns colSpec gns = if cols == 1 then [gns] -- dont care about horizontal layouts since all of them go in 1 column else (balancedGroups cols . concat . gridNodesHorizontalPartitions) gns where cols = columns colSpec gns gridNodesHorizontalPartitions :: [GridNode a] -> [[GridNode a]] gridNodesHorizontalPartitions = map snd . sortByFst . partitionByEq (horizontalHint . layoutHints) columnsQtyOpts = [1,2,3,4] defaultColumnQty = 1 -- select the number of columns that will be used for a subset of the children of a container -- The first argument, is the container specification of columns -- the second argument is a subset of the children of the container to layout columns :: Maybe Int -> [GridNode a] -> Int columns colSpec gns = fromMaybe (columnsQtyElection gns) colSpec -- uses valid votes from children to select from columnsQtyOpts or the default if there are no valid votes columnsQtyElection :: [GridNode a] -> Int columnsQtyElection = selectColumnQtyOption . catMaybes . map (columnsQtyVote . layoutHints) selectColumnQtyOption :: [Int] -> Int selectColumnQtyOption [] = defaultColumnQty selectColumnQtyOption votes = (head . sortOptionsByVotes columnsQtyOpts) votes sortOptionsByVotes :: [Int] -> [Int] -> [Int] sortOptionsByVotes opts votes = sortBy (comparing (distance votes)) opts where distance :: [Int] -> Int -> Int distance vs opt = sum $ map (sqr . (opt-) ) vs sqr x = x*x -------------------------------------- ------ More GridNode combinators ----- -------------------------------------- boxInMain, boxInHeader, boxInFooter, boxInLeftSidebar, boxInRightSidebar :: a -> GridNode a boxInMain = inMain . toBox boxInHeader = inHeader . toBox boxInFooter = inFooter . toBox boxInLeftSidebar = inLeftSidebar . toBox boxInRightSidebar = inRightSidebar . toBox -- unsafe fromBox :: GridNode a -> a fromBox (Box x _) = x toBox :: a -> GridNode a toBox x = Box x blankHints fromContainer :: GridNode a -> [GridNode a] fromContainer (Container xs _) = xs toContainer :: [GridNode a] -> GridNode a toContainer xs = Container xs blankHints ------------------------------ ------ Utility functions ----- ------------------------------ {- | Separates a list of elements in n lists of list of elements (or n groups), being n the value of the first arg. The number of elements in the lists produced is balanced. As the number of elements in the orginal group might not be a multiple of n, some lists produced will have one more elements than others Some examples of the usage of the function: balancedGroups 3 [1..9] = [[1,2,3],[4,5,6],[7,8,9]] balancedGroups 3 [1..10] = [[1,2,3,4],[5,6,7],[8,9,10]] balancedGroups 3 [1..11] = [[1,2,3,4],[5,6,7,8],[9,10,11]] balancedGroups 3 [1..12] = [[1,2,3,4],[5,6,7,8],[9,10,11,12]] -} balancedGroups :: Int -> [a] -> [[a]] balancedGroups n xs = bigGroups ++ smallGroups where (bigGroups, xs') = iterateNTimes bigGroupsQty (splitAt elemsQtyMax) xs (smallGroups, xs'') = iterateNTimes smallGroupsQty (splitAt elemsQtyMin) xs' elemsQtyMin = xsLength `div` n elemsQtyMax = elemsQtyMin + 1 bigGroupsQty = xsLength `mod` n smallGroupsQty = n - bigGroupsQty xsLength = length xs iterateNTimes :: Int -> (a -> (b,a)) -> a -> ([b],a) iterateNTimes 0 f seed = ([],seed) iterateNTimes n f seed = (x:xs, seed'') where (x, seed') = f seed (xs, seed'') = iterateNTimes (n-1) f seed' sortByFst :: Ord a => [(a,b)] -> [(a,b)] sortByFst = sortBy (comparing fst) partitionByEq :: Eq b => (a -> b) -> [a] -> [(b,[a])] partitionByEq f = partitionByEq' . map (\x->(f x, x)) partitionByEq' :: Eq b => [(b,a)] -> [(b,[a])] partitionByEq' [] = [] partitionByEq' ((y,x): ysxs) = (y, x:inClassY) : partitionByEq' ysxs' where (withY, ysxs') = partition ( (==y) . fst) ysxs inClassY = map snd withY occurrencies :: Eq a => [a] -> [(a,Int)] occurrencies [] = [] occurrencies (x:xs) = let (equalsToX,others) = partition (==x) xs in (x, 1 + length equalsToX) : occurrencies others occurresMost :: Eq a => [a] -> Maybe a occurresMost xs = case occurrencies xs of [] -> Nothing howManies -> (Just . fst . maximumBy cmp) howManies where cmp (_,x) (_,y) = compare x y