cal-layout-0.1.0.1: src/CalLayout.hs

module CalLayout where

import Data.List
import Data.Tree

type TimeUnit = Int

-- | Main interface for events.
class (Eq a) => CalEvent a where
    start :: a -> TimeUnit
    end :: a -> TimeUnit

-- | Dimension data type.
data Dimension = Dimension {
    top :: Double
    , left :: Double
    , width :: Double
    , height :: Double
} deriving (Show)

-- | Insert an event into a tree by calculating intersections.
insertEventTree :: (CalEvent a) => a -> Tree a -> Tree a
insertEventTree e n@(Node t t') = if e `intersects` t then Node t (insertEventForest e t') else n

-- | Given two events, check if they intersect.
intersects :: (CalEvent a) => a -> a -> Bool
intersects e e' = (start e >= start e' && start e < end e')
                       || ((start e' == start e) || (end e' == end e))

-- | Given an event and a tree, check if the tree contains it.
treeContains :: (CalEvent a) => a -> Tree a -> Bool
treeContains e (Node e' [])  = e == e'
treeContains e (Node e' trs) = e == e' || any (treeContains e) trs

-- | Insert an event in a forest.
insertEventForest :: (CalEvent a) => a -> Forest a -> Forest a
insertEventForest e []     = [Node e []]
insertEventForest e (t:ts) = let newTree = insertEventTree e t in
                                 if treeContains e newTree
                                 then newTree : ts
                                 else t : insertEventForest e ts

-- | Make intersections forest by recursively using `insertEvent`.
-- we need to provide an initial member since a `Data.Tree` cannot be empty.
mkIntersectionsForest :: (CalEvent a) => [a] -> Forest a
mkIntersectionsForest events = go (sortBy startSort events) []
    where
    -- | startSort first sorts by start time, then length of events
    startSort e1 e2  | start e1 == start e2 = lengthSort e1 e2
                     | start e1 < start e2  = LT
                     | otherwise            = GT
    -- | Sorts by length of events
    lengthSort e1 e2 | end e2 < end e1 = LT
                     | otherwise       = GT
    -- | Iterative function for constructing the forest
    go [] forest     = forest
    go (e:es) forest = go es (insertEventForest e forest)

-- | For a given forest, populate max depth and depth
-- we need those for calculating width/left respectively.
populateDepths :: Forest a -> [(a, Int, Int)]
populateDepths = concatMap populateDepth
    where
    calcDepth :: Tree a -> Int
    calcDepth (Node _ [])            = 0
    calcDepth (Node _ x)             = 1 + maximum (map calcDepth x)
    squish :: Int -> Tree a -> [(a, Int, Int)] -> [(a, Int, Int)]
    squish maxDepth n@(Node x ts) xs = (x, maxDepth, calcDepth n) : foldr (squish maxDepth) xs ts
    populateDepth :: Tree a -> [(a, Int, Int)]
    populateDepth t                  = squish (calcDepth t) t []

-- | Calculate dimensions for a forest.
calculateDimensions :: (CalEvent a) => Forest a -> [(a, Dimension)]
calculateDimensions forest = go (populateDepths forest)
    where
    go []                          = []
    go ((e, maxDepth, depth) : xs) = (e, Dimension top left width height) : go xs
        where
        -- top is straightforward.
        top    = fromIntegral $ start e
        -- left is a little more complex, since it relies on depth.
        left   = width * fromIntegral depth
        -- width is a little more complex, since it relies on max depth.
        width  = 100 / (1 + fromIntegral maxDepth)
        -- height is straightforward.
        height = fromIntegral $ end e - start e

-- | Helper wrapper for getting dimensions.
getDimensions :: (CalEvent a) => [a] -> [(a, Dimension)]
getDimensions events = calculateDimensions $ mkIntersectionsForest events