instance showInterval :: Show i => Show (Interval' i) where
  show (Interval i) = "Interval {start: " <> show i.start <> ", end: " <> show i.end <> "}"

start :: forall i. Interval' i -> i
start (Interval i) = i.start
end :: forall i. Interval' i -> i
end (Interval i) = i.end

import Control.Monad.State (State, put, get, evalState)

import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)

import Data.Array (reverse, filter)

import Data.Array (reverse)
import Data.Date as D

import Data.DateTime (DateTime(..), adjust, date)

import Data.DateTime as DT
import Data.DateTime (DateTime(..), date)

import Data.Maybe (Maybe(..), maybe, isJust, isNothing)

import Data.Maybe (Maybe(..), maybe, isJust, isNothing, fromMaybe)

import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..), fst)
import Data.Unfoldable (fromMaybe)
import Math (abs)

import Data.Traversable (traverse_, traverse)
import Data.Tuple (Tuple(..))
import Data.Unfoldable as U

import CSS (backgroundColor, clear, clearBoth, border, rgb, solid, borderRadius, left)
import CSS.Display (position, absolute)

import CSS (backgroundColor, clear, clearBoth, border, rgb, solid, borderRadius, marginLeft)
import CSS.Display (display, flex)

import Aftok.Api.Timeline (TimelineError, Interval'(..), Interval, TimeSpan)

import Aftok.Api.Timeline (TimelineError, Interval'(..), Interval, TimeSpan, start, end, interval)

import Aftok.Project (Project, Project'(..), ProjectId)

import Aftok.Project (Project, Project'(..), ProjectId, pidStr)

type DayIntervals = 
  { dayBounds :: Interval
  , loggedIntervals :: Array Interval
  }
type History = M.Map Date DayIntervals

  { limits  :: TimelineLimits
  , history :: M.Map Date (Array Interval)

  { selectedProject :: Maybe Project
  , history :: M.Map Date DayIntervals

  , selectedProject :: Maybe Project

  , activeHistory :: M.Map Date DayIntervals

      { limits: { bounds: TL.interval bottom bottom, current: bottom }

      { selectedProject: Nothing

      , selectedProject: Nothing

      , activeHistory: M.empty

            , lineHtml $ intervalHtml st.limits.bounds <$> currentHistory st
            ] <> ((\(Tuple d xs) -> dateLine st d xs) <$> priorHistory st))

             ] <> (historyLine <$> reverse (M.toUnfoldable $ unionHistories st.history st.activeHistory))
            )

    eval = case _ of
      Initialize -> do
        dt@(DateTime today t) <- lift system.nowDateTime
        H.put $ { limits : { bounds: dateBounds today
                           , current: fromDateTime dt
                           }
                , history : M.empty 
                , active : Nothing
                , selectedProject: Nothing
                }
        _ <- H.subscribe caps.timer
        pure unit

    eval action = do
      case action of
        Initialize -> do
          void $ H.subscribe caps.timer

      ProjectSelected p -> do
        active <- isJust <$> H.gets (_.active)
        currentProject <- H.gets (_.selectedProject)
        when (active && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)
             (traverse_ logEnd currentProject)
        timeSpan <- TL.Before <$> lift system.nowDateTime -- FIXME, should come from a form control
        intervals' <- lift $ caps.listIntervals (unwrap p).projectId timeSpan
        let intervals = case intervals' of
             Left err -> [] -- FIXME
             Right ivals -> ivals
        H.modify_ (_ { selectedProject = Just p, history = toHistory intervals })

        ProjectSelected p -> do
          active <- isJust <$> H.gets (_.active)
          currentProject <- H.gets (_.selectedProject)
          when (active && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)
               (traverse_ logEnd currentProject)
          timeSpan <- TL.Before <$> lift system.nowDateTime -- FIXME, should come from a form control
          intervals' <- lift $ caps.listIntervals (unwrap p).projectId timeSpan
          intervals <- lift $ case intervals' of
                Left err -> 
                  (system.log $ "Error occurred listing intervals") *>
                  pure [] 
                Right ivals -> 
                  (system.log $ "Got " <> show (length ivals :: Int) <> " intervals for project " <> pidStr (unwrap p).projectId) *>
                  pure ivals
          history' <- lift <<< runMaybeT $ toHistory system intervals
          hist <- case history' of
              Nothing -> lift $ system.log "Project history was empty." *> pure M.empty
              Just h -> pure h
          H.modify_ (_ { selectedProject = Just p, history = hist })

      Start   -> do
        project <- H.gets (_.selectedProject)
        traverse_ logStart project

        Start   -> do
          project <- H.gets (_.selectedProject)
          traverse_ logStart project
        Stop    -> do
          currentProject <- H.gets (_.selectedProject)
          traverse_ logEnd currentProject

      Stop    -> do
        currentProject <- H.gets (_.selectedProject)
        traverse_ logEnd currentProject

        Refresh -> do
          t <- lift $ system.now
          H.modify_ (refresh t)

      Refresh -> do
        t <- lift $ system.now
        H.modify_ (refresh t)

      -- common updates, irrespective of action
      active <- H.gets (_.active)
      activeHistory <- lift <<< map (fromMaybe M.empty) <<< runMaybeT $ toHistory system (U.fromMaybe active)
      H.modify_ (_ { activeHistory = activeHistory })

        Right t -> H.modify_ (start t)

        Right t -> H.modify_ (updateStart t)

        Right t -> H.modify_ (stop t)

        Right t -> do
          currentState <- H.get
          updatedState <- lift $ updateStop system t currentState
          H.put updatedState

dateBounds :: Date -> Interval
dateBounds date =
  let startOfDay = DateTime date bottom
      endOfDay = adjust (Days 1.0) startOfDay
      startInstant = fromDateTime startOfDay
   in TL.interval startInstant (maybe startInstant fromDateTime endOfDay)

historyLine 
  :: forall w i
  .  Tuple Date DayIntervals
  -> HH.HTML w i
historyLine (Tuple d xs) = 
  datedLine d xs.dayBounds xs.loggedIntervals

currentHistory 
  :: TimelineState

datedLine 
  :: forall w i
  .  Date
  -> Interval 

currentHistory st =
  let currentDate = date $ toDateTime st.limits.current
   in maybe [] identity (M.lookup currentDate st.history) <> fromMaybe st.active
priorHistory 
  :: TimelineState
  -> Array (Tuple Date (Array Interval))
priorHistory st = 
  let currentDate = date $ toDateTime st.limits.current
   in reverse <<< filter (not <<< (currentDate == _) <<< fst) $ M.toUnfoldable st.history
dateLine 
  :: forall action slots m
  .  TimelineState
  -> Date
  -> Array Interval
  -> H.ComponentHTML action slots m
dateLine st d xs =

  -> HH.HTML w i
datedLine d dateBounds xs =

    []

    [ CSS.style do
        clear clearBoth 
    ]

    , lineHtml (intervalHtml (dateBounds d) <$> xs)

    , HH.div
      [ CSS.style do
          border solid (px 3.0) (rgb 0x00 0xFF 0x00)
          borderRadius px5 px5 px5 px5
          height (px $ 44.0)
          display flex
      , P.classes (ClassName <$> ["my-2"])
      ]
      (evalState (traverse (intervalHtml dateBounds) xs) 0.0)

  where 
    px5 = px 5.0

lineHtml
  :: forall action slots m
  .  Array (H.ComponentHTML action slots m)
  -> H.ComponentHTML action slots m
lineHtml contents =
  let px5 = px 5.0
   in HH.div
    [ CSS.style do
        clear clearBoth
        border solid (px 3.0) (rgb 0x00 0xFF 0x00)
        height (px 50.0)
        borderRadius px5 px5 px5 px5
    , P.classes (ClassName <$> ["my-2"])
    ]
    contents

  :: forall action slots m

  :: forall w i 

  -> H.ComponentHTML action slots m
intervalHtml (Interval limits) (Interval i) =

  -> State Number (HH.HTML w i)
intervalHtml (Interval limits) (Interval i) = do
  offset <- get

      ileft = ilen limits.start i.start

      ileft = ilen limits.start i.start 

   in HH.div

  put $ toPct (ilen limits.start i.end)
  pure $ HH.div

        position absolute

        height (px $ 44.0)
        left (pct $ toPct ileft)

        marginLeft (pct $ toPct ileft - offset)

start :: Instant -> TimelineState -> TimelineState
start t s =
  s { active = s.active <|> Just (TL.interval t t)
    }

updateStart :: Instant -> TimelineState -> TimelineState
updateStart t s = 
  s { active = s.active <|> Just (TL.interval t t) }

stop :: Instant -> TimelineState -> TimelineState
stop t s =
  s { history = maybe 
        s.history 
        (\i -> M.unionWith (<>) (toHistory [TL.interval (unwrap i).start t]) s.history) 
        s.active
    , active = Nothing
    }

updateStop 
  :: forall m
  .  Monad m
  => System m 
  -> Instant 
  -> TimelineState 
  -> m TimelineState
updateStop system t st = do
  newHistory <- join <$> traverse (\i -> runMaybeT $ toHistory system [TL.interval (start i) t]) st.active
  pure { selectedProject: st.selectedProject
       , history: maybe st.history (unionHistories st.history) newHistory 
       , active: Nothing
       , activeHistory: M.empty
       }

  s { limits = s.limits { current = t }
    , active = map (\(Interval i) -> TL.interval i.start t) s.active

  s { active = map (\(Interval i) -> TL.interval i.start t) s.active

  in  abs $ n (unInstant _end) - n (unInstant _start)

  in  n (unInstant _end) - n (unInstant _start)

intervalDate :: Interval -> Date
intervalDate = date <<< toDateTime <<< (_.end) <<< unwrap

utcDayBounds :: Instant -> Interval
utcDayBounds i =
  let startOfDay = DateTime (date $ toDateTime i)  bottom
      endOfDay = DT.adjust (Days 1.0) startOfDay
      startInstant = fromDateTime startOfDay
   in TL.interval startInstant (maybe startInstant fromDateTime endOfDay)

toHistory :: Array Interval -> M.Map Date (Array Interval)
toHistory = M.fromFoldableWith (<>) <<< map (\i -> Tuple (intervalDate i) [i])

localDayBounds 
  :: forall m
  .  Monad m
  => System m
  -> Instant 
  -> MaybeT m (Tuple Date Interval)
localDayBounds system t = do
  Tuple date start <- MaybeT $ system.dateFFI.midnightLocal t
  end <- MaybeT <<< pure $ fromDateTime <$> DT.adjust (Days 1.0) (toDateTime start)
  pure $ Tuple date (interval start end)
incrementDayBounds :: Tuple Date Interval -> Maybe (Tuple Date Interval)
incrementDayBounds (Tuple d i) =
  let nextEnd = fromDateTime <$> (DT.adjust (Days 1.0) $ toDateTime (end i))
   in Tuple <$> D.adjust (Days 1.0) d
            <*> (interval (end i) <$> nextEnd)
splitInterval 
  :: forall m
  .  Monad m
  => System m
  -> Interval 
  -> MaybeT m (Array (Tuple Date DayIntervals))
splitInterval system i = do
  lift <<< system.log $ "Splitting interval " <> show i
  dayBounds@(Tuple date bounds) <- localDayBounds system (start i)
  split <- if end i < (end bounds)
     then do
       pure [Tuple date { dayBounds: bounds, loggedIntervals: [i] }]
     else do
       let firstFragment = [ Tuple date { dayBounds: bounds
                           , loggedIntervals: [interval (start i) (end bounds)] 
                           } ]
       append firstFragment <$> splitInterval system (interval (end bounds) (end i))
  lift <<< system.log $ "Split result: " <> show split
  pure split
toHistory 
  :: forall m
  .  Monad m
  => System m
  -> Array Interval 
  -> MaybeT m (M.Map Date DayIntervals)
toHistory system xs = do
  splitIntervals <- join <$> traverse (splitInterval system) xs
  pure $ M.fromFoldableWith unionDayIntervals splitIntervals

unionDayIntervals :: DayIntervals -> DayIntervals -> DayIntervals
unionDayIntervals d1 d2 = 
  { dayBounds: d1.dayBounds -- FIXME, need to be sure these match
  , loggedIntervals: d1.loggedIntervals <> d2.loggedIntervals 
  }
unionHistories :: History -> History -> History
unionHistories = M.unionWith unionDayIntervals

import Data.Date (Date)

import Data.JSDate as JSDate

import Data.JSDate as JD

import Data.Tuple (Tuple(..))

  , dateFFI :: DateFFI m

  , dateFFI: hoistDateFFI liftEffect jsDateFFI
  }
type DateFFI m =
  { midnightLocal :: Instant -> m (Maybe (Tuple Date Instant))

jsDateFFI :: DateFFI Effect
jsDateFFI = 
  { midnightLocal
  }
midnightLocal :: Instant -> Effect (Maybe (Tuple Date Instant))
midnightLocal i = do
  let jsDate = JD.fromInstant i
  year  <- JD.getFullYear jsDate
  month <- JD.getMonth jsDate
  day   <- JD.getDate jsDate
  jsMidnight <- midnightLocalJS year month day
  let date = JD.toDate jsMidnight
  pure $ Tuple <$> date <*> JD.toInstant jsMidnight
midnightLocalJS :: Number -> Number -> Number -> Effect JD.JSDate
midnightLocalJS year month day = JD.jsdateLocal
  { year
  , month
  , day
  , hour: 0.0
  , minute: 0.0
  , second: 0.0
  , millisecond: 0.0
  }
hoistDateFFI :: forall m n. (forall a. m a -> n a) -> DateFFI m -> DateFFI n
hoistDateFFI nt ffi = 
    { midnightLocal: \i -> nt (ffi.midnightLocal i)
    }

  jsDate <- lift $ JSDate.parse str

  jsDate <- lift $ JD.parse str

                (JSDate.toDateTime jsDate)

                (JD.toDateTime jsDate)

    initialState _ = LoggedOut

    initialState _ = Loading

    render s = case s of

    render = case _ of

      LoginComplete (Login.LoginComplete xs) -> 

      LoginComplete (Login.LoginComplete _) ->