content: -- | Block output similar to default org reporting. This is stub
  -- version which is to be improved later.
  
  module OrgStat.Outputs.Block
         ( genBlockOutput
         ) where
  
  import Universum
  
  import qualified Data.List as L
  import qualified Data.Text as T
  import Text.PrettyPrint.Boxes (center1, hsep, left, render, right, text, vcat)
  
  import OrgStat.Ast (Org, filterHasClock, orgSubtrees, orgTitle, orgTotalDuration)
  import OrgStat.Outputs.Types (BlockOutput(..), BlockParams(..))
  import OrgStat.Util (dropEnd, timeF)
  
  data BlockFrames = BlockFrames
      { bfAngle1     :: Text
      , bfAngle2     :: Text
      , bfHorizontal :: Text
      , bfVertical   :: Text
      } deriving Show
  
  unicodeBlockFrames,asciiBlockFrames :: BlockFrames
  unicodeBlockFrames = BlockFrames "├" "└" "─" "│"
  asciiBlockFrames = BlockFrames "|" "\\" "-" "|"
  
  -- | Generate block output (emacs table-like).
  genBlockOutput :: BlockParams -> Org -> BlockOutput
  genBlockOutput BlockParams{..} (filterHasClock -> o0) = do
      BlockOutput $ fromString $ render $
          hsep 2 center1 [vsep,col1,vsep,col2,vsep]
    where
      BlockFrames{..} = if _bpUnicode then unicodeBlockFrames else asciiBlockFrames
      text' = text . toString
      elems' = withDepth (0::Int) o0
      col1 = vcat left $ map (text' . trimTitle . fst) elems'
      col2 = vcat right $ map (text' . snd) elems'
      vsep = vcat center1 $ replicate (length elems') (text $ toString bfVertical)
  
      trimTitle t | T.length t > _bpMaxLength = T.take (_bpMaxLength - 3) t <> "..."
                  | otherwise = t
      formatter o =
          let dur = orgTotalDuration o
              titleRaw = T.take _bpMaxLength $ o ^. orgTitle
          in (titleRaw, timeF dur)
  
      withDepth :: Int -> Org -> [(Text,Text)]
      withDepth i o = do
          let (name,dur) = formatter o
          let children = map (withDepth (i+1)) (o ^. orgSubtrees)
          let processChild,processLastChild :: [(Text,Text)] -> [(Text,Text)]
              processChild [] = []
              processChild (pair0:pairs) =
                  first ((bfAngle1 <> bfHorizontal <> " ") <>) pair0 :
                  map (first ((bfVertical <> "  ") <>)) pairs
              processLastChild [] = []
              processLastChild (pair0:pairs) =
                  first ((bfAngle2 <> bfHorizontal <> " ") <>) pair0 :
                  map (first ("   " <>)) pairs
          let childrenProcessed
                  | null children = []
                  | otherwise =
                        concat $
                        map processChild (dropEnd 1 children) ++
                        [processLastChild (L.last children)]
          (name,dur) : childrenProcessed
  