content: {-# LANGUAGE RankNTypes, ScopedTypeVariables, TemplateHaskell #-}
  
  -- | Timeline reporting output. Prouces a svg with columns.
  
  module OrgStat.Outputs.Timeline
         ( processTimeline
         ) where
  
  import Data.Colour.CIE (luminance)
  import Data.List (lookup, nub)
  import qualified Data.List as L
  import qualified Data.Text as T
  import Data.Time (Day, DiffTime, LocalTime(..), defaultTimeLocale, formatTime, timeOfDayToTime)
  import Diagrams.Backend.SVG (B)
  import qualified Diagrams.Prelude as D
  import qualified Prelude
  import Text.Printf (printf)
  import Universum
  
  import OrgStat.Ast (Clock(..), Org(..), orgClocks, traverseTree)
  import OrgStat.Outputs.Types
    (TimelineOutput(..), TimelineParams, tpBackground, tpColorSalt, tpColumnHeight, tpColumnWidth,
    tpLegend, tpTopDay)
  import OrgStat.Util (addLocalTime, hashColour)
  
  
  
  ----------------------------------------------------------------------------
  -- Processing clocks
  ----------------------------------------------------------------------------
  
  -- [(a, [b])] -> [(a, b)]
  allClocks :: [(Text, [(DiffTime, DiffTime)])] -> [(Text, (DiffTime, DiffTime))]
  allClocks tasks = do
      (label, clocks) <- tasks
      clock <- clocks
      pure (label, clock)
  
  -- separate list for each day
  selectDays :: [Day] -> [(Text, [Clock])] -> [[(Text, [(DiffTime, DiffTime)])]]
  selectDays days tasks =
      flip map days $ \day ->
        filter (not . null . snd) $
        map (second (selectDay day)) tasks
    where
      selectDay :: Day -> [Clock] -> [(DiffTime, DiffTime)]
      selectDay day clocks = do
          Clock (LocalTime dFrom tFrom) (LocalTime dTo tTo) <- clocks
          guard $ any (== day) [dFrom, dTo]
          let tFrom' = if dFrom == day then timeOfDayToTime tFrom else fromInteger 0
          let tTo'   = if dTo   == day then timeOfDayToTime tTo   else fromInteger (24*60*60)
          pure (tFrom', tTo')
  
  -- total time for each task
  totalTimes :: [(Text, [(DiffTime, DiffTime)])] -> [(Text, DiffTime)]
  totalTimes tasks = map (second clocksSum) tasks
    where
      clocksSum :: [(DiffTime, DiffTime)] -> DiffTime
      clocksSum clocks = sum $ map (\(start, end) -> end - start) clocks
  
  -- list of leaves
  orgToList :: Org -> [(Text, [Clock])]
  orgToList = orgToList' ""
    where
      orgToList' :: Text -> Org -> [(Text, [Clock])]
      orgToList' _pr org =
        --let path = pr <> "/" <> _orgTitle org
        let path = _orgTitle org
        in (path, _orgClocks org) : concatMap (orgToList' path) (_orgSubtrees org)
  
  
  ----------------------------------------------------------------------------
  -- Drawing
  ----------------------------------------------------------------------------
  
  
  diffTimeSeconds :: DiffTime -> Integer
  diffTimeSeconds time = floor $ toRational time
  
  diffTimeMinutes :: DiffTime -> Integer
  diffTimeMinutes time = diffTimeSeconds time `div` 60
  
  -- diffTimeHours :: DiffTime -> Integer
  -- diffTimeHours time = diffTimeMinutes time `div` 60
  
  
  labelColour :: TimelineParams -> Text -> D.Colour Double
  labelColour params _label = hashColour (params ^. tpColorSalt) _label
  
  -- | Returns if the label is to be shown. Second param is font-related
  -- heuristic constant, third is length of interval.
  fitLabelHeight :: TimelineParams -> Double -> Double -> Bool
  fitLabelHeight params n h = h >= (params ^. tpColumnHeight) * n
  
  -- | Decides by <heuristic param n depending on font>, width of column
  -- and string, should it be truncated. And returns modified string.
  fitLabelWidth :: TimelineParams -> Double -> Text -> Text
  fitLabelWidth params n s =
      if T.length s <= toTake then s else T.take toTake s <> ".."
    where
      toTake = floor $ n * ((params ^. tpColumnWidth) ** 1.2)
  
  -- rectangle with origin in the top-left corner
  topLeftRect :: Double -> Double -> D.Diagram B
  topLeftRect w h =
    D.rect w h
    & D.moveOriginTo (D.p2 (-w/2, h/2))
  
  -- timeline for a single day
  timelineDay :: TimelineParams -> Day -> [(Text, (DiffTime, DiffTime))] -> D.Diagram B
  timelineDay params day clocks =
      mconcat
        [ timeticks
        , dateLabel
        , mconcat (map showClock clocks)
        , clocksBackground
        ]
    where
      width = 140 * (params ^. tpColumnWidth)
      ticksWidth = 20
      height = 700 * (params ^. tpColumnHeight)
  
      timeticks :: D.Diagram B
      timeticks =
        mconcat $
        flip map [(0::Int)..23] $ \hour ->
        mconcat
          [ D.alignedText 0.5 1 (show hour)
            & D.font "DejaVu Sans"
            & D.fontSize 8
            & D.moveTo (D.p2 (ticksWidth/2, -5))
            & D.fc (D.sRGB24 150 150 150)
          , D.strokeT (D.p2 (0,0) D.~~ (D.p2 (ticksWidth, 0)))
            & D.translateY (-0.5)
            & D.lwO 1
            & D.lc (D.sRGB24 200 200 200)
          ]
        & D.moveTo (D.p2 (0, negate $ fromInteger . round $ height * (fromIntegral hour / 24)))
        & D.moveOriginTo (D.p2 (ticksWidth, 0))
  
      dateLabel :: D.Diagram B
      dateLabel =
        mconcat
        [ D.strutY 20
        , D.alignedText 0.5 0 (formatTime defaultTimeLocale "%a, %d.%m.%Y" day)
          & D.font "DejaVu Sans"
          & D.fontSize 12
          & D.moveOriginTo (D.p2 (-width/2, 0))
        ]
  
      clocksBackground :: D.Diagram B
      clocksBackground =
        topLeftRect width height
        & D.lw D.none
        & D.fc (params ^. tpBackground)
  
      contrastFrom c = if luminance c < 0.14 then D.sRGB24 224 224 224 else D.black
  
      showClock :: (Text, (DiffTime, DiffTime)) -> D.Diagram B
      showClock (label, (start, end)) =
        let
          w = width
          h = (* height) $ fromInteger (diffTimeMinutes $ end - start) / (24*60)
          y = (* height) $ fromInteger (diffTimeMinutes start) / (24*60)
  
          bgboxColour = labelColour params label
          bgbox = topLeftRect w h
                & D.lw D.none
                & D.fc bgboxColour
          label' = D.alignedText 0 0.5 (T.unpack $ fitLabelWidth params 21 label)
                 & D.font "DejaVu Sans"
                 & D.fontSize 10
                 & D.fc (contrastFrom bgboxColour)
                 & D.moveTo (D.p2 (5, -h/2))
          box = mconcat $ bool [] [label'] (fitLabelHeight params 11 h) ++ [bgbox]
        in box & D.moveTo (D.p2 (0, -y))
  
  -- timelines for several days, with top lists
  timelineDays
    :: TimelineParams
    -> [Day]
    -> [[(Text, (DiffTime, DiffTime))]]
    -> [[(Text, DiffTime)]]
    -> D.Diagram B
  timelineDays params days clocks topLists =
      (D.strutY 10 D.===) $
      D.hcat $
      flip map (days `zip` (clocks `zip` topLists)) $ \(day, (dayClocks, topList)) ->
        D.vsep 5
        [ timelineDay params day dayClocks
        , taskList params topList True
        ]
  
  -- task list, with durations and colours
  taskList :: TimelineParams -> [(Text, DiffTime)] -> Bool -> D.Diagram B
  taskList params labels fit = D.vsep 5 $ map oneTask $ reverse $ sortOn snd labels
    where
      oneTask :: (Text, DiffTime) -> D.Diagram B
      oneTask (label, time) =
        D.hsep 3
        [ D.alignedText 1 0.5 (showTime time)
          & D.font "DejaVu Sans"
          & D.fontSize 10
          & D.translateX 20
        , D.rect 12 12
          & D.fc (labelColour params label)
          & D.lw D.none
        , D.alignedText 0 0.5 (T.unpack $ bool label (fitLabelWidth params 18 label) fit)
          & D.font "DejaVu Sans"
          & D.fontSize 10
        ]
  
      showTime :: DiffTime -> Prelude.String
      showTime time = printf "%d:%02d" hours minutes
        where
          (hours, minutes) = diffTimeMinutes time `divMod` 60
  
  emptyReport :: D.Diagram B
  emptyReport =
        mconcat
        [ D.strutY 20
        , D.strutX 40
        , D.alignedText 0.5 0 "empty"
          & D.font "DejaVu Sans"
          & D.fontSize 8
        ]
  
  timelineReport :: TimelineParams -> Org -> TimelineOutput
  timelineReport params org =
      if (null $ concat $ org ^.. traverseTree . orgClocks)
      then
        TimelineOutput $ D.vsep 30 [emptyReport]
  
      else TimelineOutput pic
    where
      lookupDef :: Eq a => b -> a -> [(a, b)] -> b
      lookupDef d a xs = fromMaybe d $ lookup a xs
  
      -- These two should be taken from the Org itself (min/max).
      (from,to) =
          let c = concat $ org ^.. traverseTree . orgClocks
          in (L.minimum (map cFrom c), L.maximum (map cTo c))
  
      -- period to show. Right border is -1min, we assume it's non-inclusive
      daysToShow = [localDay from ..
                    localDay ((negate 120 :: Int) `addLocalTime` to)]
  
      -- unfiltered leaves
      tasks :: [(Text, [Clock])]
      tasks = orgToList org
  
      -- tasks from the given period, split by days
      byDay :: [[(Text, [(DiffTime, DiffTime)])]]
      byDay = selectDays daysToShow tasks
  
      -- total durations for each task, split by days
      byDayDurations :: [[(Text, DiffTime)]]
      byDayDurations = map totalTimes byDay
  
      -- total durations for the whole period
      allDaysDurations :: [(Text, DiffTime)]
      allDaysDurations =
        let allTasks = nub $ map fst $ concat byDayDurations in
        flip map allTasks $ \task ->
        (task,) $ sum $ flip map byDayDurations $ \durations ->
        lookupDef (fromInteger 0) task durations
  
      -- split clocks
      clocks :: [[(Text, (DiffTime, DiffTime))]]
      clocks = map allClocks byDay
  
      -- top list for each day
      topLists :: [[(Text, DiffTime)]]
      topLists =
          map (take (params ^. tpTopDay) . reverse . sortOn (\(_task, time) -> time))
          byDayDurations
  
      optLegend | params ^. tpLegend = [taskList params allDaysDurations False]
                | otherwise = []
  
      pic =
        D.vsep 30 $ [ timelineDays params daysToShow clocks topLists ] ++ optLegend
  
  processTimeline :: TimelineParams -> Org -> TimelineOutput
  processTimeline params org = timelineReport params org
  