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