replace box and color system by homemade table system

package.yaml

@@ -27,14 +27,9 @@ library:
   dependencies:
   - aeson
   - base-compat
-  - boxes
   - bytestring
-  - containers
   - directory
   - human-readable-duration
-  - rainbow
-  - rainbox
-  - text
   - time
 
 executables:

src/Command.hs

@@ -6,15 +6,12 @@ import           Data.List                      ( union )
 import           Data.Time
 import           Control.Monad
 import           Data.Time.Clock.POSIX
-import           Text.PrettyPrint.Boxes
-import           Text.Read
 
 import           Event
 import           Response
 import           State
 import           Store
 import           Task
-import           Utils
 import qualified Parsec
 
 data Command

src/Query.hs

@@ -8,15 +8,13 @@ import           Data.Fixed
 import           Data.List
 import           Data.Maybe
 import           Data.Time
-import           Text.PrettyPrint.Boxes
 import           Text.Read
 
 import           Event
 import           Response
 import           State
 import           Store
 import           Task
-import           Utils
 import qualified Parsec
 
 data Query

src/Response.hs

@@ -39,6 +39,7 @@ printWtime rtype msg wtime = case rtype of
     putStrLn msg
     putStrLn ""
     prettyPrintWtime wtime
+    putStrLn ""
 
 printVersion :: ResponseType -> String -> IO ()
 printVersion rtype version = case rtype of

src/State.hs

@@ -7,7 +7,6 @@ import           Data.Time
 
 import           Event
 import           Task
-import           Utils
 
 data State = State { _tasks :: [Task]
                    , _ctx :: [Tag]

src/Store.hs

@@ -11,7 +11,6 @@ import           System.IO.Error
 
 import           Event
 import           State
-import           Utils
 
 readEvents :: IO [Event]
 readEvents = mapLineToEvent <$> getStoreFileContent

src/Table.hs

@@ -0,0 +1,79 @@
+module Table where
+
+import           Data.List
+
+type Style = String
+type Value = String
+
+data Cell = Cell [Style] Value
+
+instance Show Cell where
+  show (Cell styles val) = foldr (++) "" styles ++ val
+
+renderCell :: Int -> Cell -> String
+renderCell colSize cell = startStyle ++ val ++ padding ++ endStyle
+ where
+  val        = getCellVal cell
+  startStyle = foldr (++) "" (getCellStyles cell)
+  padding    = take (colSize - length val + 1) $ repeat ' '
+  endStyle   = "\x1b[0m"
+
+renderCols :: [[Cell]] -> [[String]]
+renderCols = map (intersperse sep) . transpose . map renderCols' . transpose
+ where
+  sep = renderCell 0 (ext 238 . cell $ "|")
+  renderCols' cells = map (renderCell colSize) cells
+    where colSize = maximum (map (length . getCellVal) cells)
+
+renderRows :: [[String]] -> [String]
+renderRows = map renderRows'
+  where renderRows' cols = foldr (++) "" cols ++ "\n"
+
+renderTable :: [String] -> String
+renderTable = foldr (++) ""
+
+render :: [[Cell]] -> IO ()
+render = putStr . renderTable . renderRows . renderCols
+
+-- Utils
+
+cell :: Value -> Cell
+cell val = Cell [] val
+
+getCellVal :: Cell -> Value
+getCellVal (Cell _ val) = val
+
+getCellStyles :: Cell -> [Style]
+getCellStyles (Cell styles _) = styles
+
+defineStyle :: Int -> Int -> Int -> Cell -> Cell
+defineStyle color bright shade (Cell styles val) = Cell (styles ++ [style]) val
+ where
+  bright' = if bright > 0 then ";" ++ show bright else ""
+  shade'  = if shade > 0 then ";" ++ show shade else ""
+  style   = "\x1b[" ++ show color ++ bright' ++ shade' ++ "m"
+
+reset = defineStyle 0 0 0
+bold = defineStyle 1 0 0
+underline = defineStyle 4 0 0
+reversed = defineStyle 7 0 0
+black = defineStyle 30 0 0
+red = defineStyle 31 0 0
+green = defineStyle 32 0 0
+yellow = defineStyle 33 0 0
+blue = defineStyle 34 0 0
+magenta = defineStyle 35 0 0
+cyan = defineStyle 36 0 0
+white = defineStyle 37 0 0
+
+brightBlack = defineStyle 30 1 0
+brightRed = defineStyle 31 1 0
+brightGreen = defineStyle 32 1 0
+brightyellow = defineStyle 33 1 0
+brightBlue = defineStyle 34 1 0
+brightMagenta = defineStyle 35 1 0
+brightCyan = defineStyle 36 1 0
+brightWhite = defineStyle 37 1 0
+
+ext :: Int -> Cell -> Cell
+ext = defineStyle 38 5

src/Task.hs

@@ -2,30 +2,14 @@
 
 module Task where
 
-import           Prelude                 hiding ( splitAt )
-import           Control.Exception
-import           Control.Monad                  ( join )
 import           Data.Aeson
 import           Data.Duration
-import           Data.List               hiding ( splitAt )
 import           Data.Fixed
-import           Data.Foldable                  ( toList )
+import           Data.List
 import           Data.Maybe
-import           Data.Sequence                  ( Seq
-                                                , (|>)
-                                                , (><)
-                                                , splitAt
-                                                )
-import           Data.Text                      ( Text
-                                                , pack
-                                                )
 import           Data.Time
-import           Rainbow
-import           Rainbox.Core            hiding ( intersperse )
-import qualified Data.ByteString.Lazy.Char8    as BL
-import qualified Data.Sequence                 as Seq
 
-import           Utils
+import           Table
 
 type Id = Int
 type Ref = Int
@@ -193,40 +177,29 @@ printHumanTime Nothing    = ""
 printHumanTime (Just due) = if due > 0 then "in " ++ due' else due' ++ " ago"
   where due' = humanReadableDuration $ abs due
 
-strToCell :: (Chunk Text -> Chunk Text) -> String -> Seq (Seq (Chunk Text))
-strToCell style = Seq.singleton . Seq.singleton . style . chunk . pack
-
-withSeparator :: Cell
-withSeparator = mconcat [space, bar]
- where
-  space = separator mempty 1
-  bar   = Cell (strToCell (fore grey) "|") top left mempty
-
 prettyPrintTasks :: [Task] -> IO ()
-prettyPrintTasks = mapM_ putChunk . toList . render' . tableTasks
+prettyPrintTasks = render . tableTasks
 
-tableTasks :: [Task] -> Box Vertical
-tableTasks tasks = tableByRows . Seq.fromList . fmap Seq.fromList $ head : body
+tableTasks :: [Task] -> [[Cell]]
+tableTasks tasks = head : body
  where
   head = tableTaskHead
   body = map tableTaskRow tasks
 
 tableTaskHead :: [Cell]
-tableTaskHead = intersperse withSeparator
-  $ map toCell ["ID", "DESC", "TAGS", "ACTIVE", "DUE"]
-  where toCell str = Cell (strToCell (underline . bold) str) top left mempty
+tableTaskHead =
+  map (bold . underline . cell) ["ID", "DESC", "TAGS", "ACTIVE", "DUE"]
 
 tableTaskRow :: Task -> [Cell]
 tableTaskRow task = cells
  where
   [id, desc, tags, active, due] = taskToStrings task
-  cells                         = intersperse
-    withSeparator
-    [ Cell (strToCell (fore red) id)       center left mempty
-    , Cell (strToCell (fore white) desc)   center left mempty
-    , Cell (strToCell (fore blue) tags)    center left mempty
-    , Cell (strToCell (fore green) active) center left mempty
-    , Cell (strToCell (fore yellow) due)   center left mempty
+  cells =
+    [ red . cell $ id
+    , cell desc
+    , blue . cell $ tags
+    , green . cell $ active
+    , yellow . cell $ due
     ]
 
 taskToStrings :: Task -> [String]
@@ -239,42 +212,28 @@ taskToStrings task =
   ]
 
 prettyPrintWtime :: [DailyWtime] -> IO ()
-prettyPrintWtime = mapM_ putChunk . toList . render' . tableWtime
+prettyPrintWtime = render . tableWtime
 
-tableWtime :: [DailyWtime] -> Box Vertical
-tableWtime wtime =
-  tableByRows . Seq.fromList . fmap Seq.fromList $ head : body ++ foot
+tableWtime :: [DailyWtime] -> [[Cell]]
+tableWtime wtime = head : body ++ foot
  where
   prettyPrint (date, wtime) = [date, humanReadableDuration $ realToFrac wtime]
   head = tableWtimeHead
   body = map tableWtimeRow wtime
   foot = [tableWtimeFoot $ foldl (\acc (_, x) -> acc + x) 0 wtime]
 
 tableWtimeHead :: [Cell]
-tableWtimeHead = intersperse withSeparator $ map toCell ["DATE", "WORKTIME"]
-  where toCell str = Cell (strToCell (underline . bold) str) top left mempty
+tableWtimeHead = map (underline . bold . cell) ["DATE", "WORKTIME"]
 
 tableWtimeRow :: DailyWtime -> [Cell]
 tableWtimeRow wtime = cells
  where
   [date, total] = wtimeToStrings wtime
-  cells         = intersperse
-    withSeparator
-    [ Cell (strToCell (fore grey) date)    center left mempty
-    , Cell (strToCell (fore yellow) total) center left mempty
-    ]
+  cells         = [cell date, yellow . cell $ total]
 
 tableWtimeFoot :: Duration -> [Cell]
-tableWtimeFoot total = intersperse
-  withSeparator
-  [ Cell (strToCell bold "TOTAL")    center left mempty
-  , Cell (strToCell bold humanTotal) center left mempty
-  ]
+tableWtimeFoot total = [bold . cell $ "TOTAL", bold . cell $ humanTotal]
   where humanTotal = humanReadableDuration total
 
 wtimeToStrings :: DailyWtime -> [String]
 wtimeToStrings (date, wtime) = [date, humanReadableDuration $ realToFrac wtime]
-
-render' :: Orientation a => Box a -> Seq (Chunk Text)
-render' box = join $ (fmap (fmap underline) fseq) >< seqs
-  where (fseq, seqs) = splitAt 1 . chunksFromRodRows . rodRows $ box