{-# LANGUAGE UnicodeSyntax #-}
-- | This module implements printing TODOs tree to console. Here is default
-- function, but user can supply his own.
module Todos.Default.Print
  (defaultPrintTodos, showTodos)

import Prelude.Unicode
import Control.Monad
import Control.Monad.Reader
import Data.List
import Data.Tree
import Data.Function (on)
import System.Console.ANSI

import Todos.Types
import Todos.Default.Config
import Todos.Default.Instances ()
import Todos.Formatters

sortBy'  SortingType  [Todo]  [Todo]
sortBy' s | s == DoNotSort = id
          | otherwise = sortBy sorter
    sorter = compare `on` (f  rootLabel)
    f = case s of
          DoNotSort  error "Internal error: sortBy' should not be called when DoNotSort is specified!"
          ByTitle  itemName
          ByStatus  itemStatus
          ByTags  unwords  itemTags
          ByStartDate  show  startDate
          ByEndDate  show  endDate
          ByDeadline  show  deadline 

showT  SortingType  Int  String  Todo  [Formatter DefaultConfig]
showT s n sep (Node item todos) = 
    (sf <++> showId item <++> seps <++> item') :
      (concatMap (showT s (n+1) sep) $ sortBy' s todos)
    sf  Formatter DefaultConfig
    sf = startFormat

    seps = concat (replicate n sep)

    item'  Formatter DefaultConfig
    item' = configShow item

    showId :: TodoItem  Formatter DefaultConfig
    showId item = do
      s  askBase outIds
      c  askBase outColors
      if s
        then if c 
               then return [OutSetColor Dull Yellow, OutString $ makeId item ++ " ", ResetAll]
               else return [OutString $ makeId item ++ " "]
        else return [OutString ""]

unlines''  [Formatter c]  Formatter c
unlines'' lst = concat `fmap` (sequence $ intersperse newLine lst)

showTodo  Todo  Formatter DefaultConfig
showTodo t = do
  conf  asks toBaseConfig
  sep  askBase indentString
  let f = case outOnlyFirst conf of
            False  unlines''
            True   head
  f $ showT (sorting conf) 0 sep t

-- | Prepare TODOs for console output
showTodos  [Todo]  Formatter DefaultConfig
showTodos lst = do
  conf  asks toBaseConfig
  let f = case outOnlyFirst conf of
            False  unlines''
            True   head
  f $ map showTodo $ sortBy' (sorting conf) $ nub lst

-- | Default function to output TODOs to console
defaultPrintTodos  PrintConfig DefaultConfig  [Todo]  IO ()
defaultPrintTodos cfg lst = 
  let lst' = runReader (showTodos lst) cfg
  in  forM lst' outItem >> putStrLn ""