Merge pull request #5 from volhovM/volhovm/pretty-block-report

Pretty block report

CHANGES.md

@@ -0,0 +1,32 @@
+0.1.2
+=====
+
+* Add pretty block output.
+
+0.1.1
+=====
+
+* Introduce concise report feature.
+* Change report hierarchy: separate reports from outputs.
+* Fix minor bugs.
+
+0.0.4
+=====
+
+* Update universum to 0.5.1.1
+* Update log-warper to 1.1.4
+
+0.0.3
+=====
+
+* Update universum/log-warper dependencies.
+
+0.0.2
+=====
+
+* Add support for log-waprer 0.4.*
+
+0.0.1
+=====
+
+* Initial release having timeline report type only.

README.md

@@ -7,7 +7,7 @@ Orgstat is a statistics visualizer tool for org-mode. Given a set of org-mode fi
 it parses AST, applies modifications such as tag filtering, pruning or selecting a subtree (which yields a _report_) and generates _output_ using specified params. Currently supported output types are:
 * Timeline output: that's a svg image describing what took your time on every day of selected report range. 
 * Summary output: you specify the template string with `%reportName%` in it and it replaces each such occurrence with total hours spent on report. Useful for putting this info into your status bar.
-* Block output: that's what you'd expect from default org report generator (though it's currently in the very raw state and used for debugging mostly).
+* Block output: that's what you'd expect from default org report generator, though formatting is more similar to one that `tree` unix utility provides.
 
 ## Building/installing
 
@@ -54,4 +54,4 @@ Then you run `stack exec orgstat -- --select-output resolveOutput --output-dir ~
 
 ## Bugs and issues
 
-If you experience any problems with the application, you may use `block` output and `--debug` to debug yourself or create the issue. 
+If you experience any problems with the application, you can use `block` output and `--debug` to debug yourself (or you can just create an issue).

orgstat.cabal

@@ -1,8 +1,9 @@
 name:                orgstat
-version:             0.1.1
+version:             0.1.2
 synopsis:            Statistics visualizer for org-mode
 license:             GPL-3
 license-file:        LICENSE
+extra-source-files:  CHANGES.md
 homepage:            https://github.com/volhovM/orgstat
 author:              Mikhail Volkhov <[email protected]>, Zhenya Vinogradov <[email protected]>
 maintainer:          [email protected]
@@ -29,6 +30,7 @@ library
   build-depends:       aeson >= 0.11.2.0
                      , attoparsec
                      , base >=4.9 && <4.10
+                     , boxes >= 0.1.4
                      , bytestring
                      , colour >= 2.3.3
                      , containers >= 0.5.7.1

orgstatExample.yaml

@@ -66,6 +66,8 @@ outputs:
   # Just output it somehow. Useful for debugging.
   - name: someDebugOutput
     type: block
+    unicode: true
+    maxLength: 60
     report: curWeekTop
 # Output folder. Subfolder for report will be auto-generated. 
 outputDir: /home/username/reps/orgstat/

src/OrgStat/Config.hs

@@ -26,9 +26,9 @@ import           Data.Time             (LocalTime)
 import           Data.Time.Format      (defaultTimeLocale, parseTimeM)
 import           Universum
 
-import           OrgStat.Outputs.Types (BlockParams (..), SummaryParams (..),
-                                        TimelineParams, tpBackground, tpColumnHeight,
-                                        tpColumnWidth, tpLegend, tpTopDay)
+import           OrgStat.Outputs.Types (BlockParams, SummaryParams (..), TimelineParams,
+                                        bpMaxLength, bpUnicode, tpBackground,
+                                        tpColumnHeight, tpColumnWidth, tpLegend, tpTopDay)
 import           OrgStat.Scope         (AstPath (..), ScopeModifier (..))
 import           OrgStat.Util          (parseColour, (??~))
 
@@ -158,7 +158,10 @@ instance FromJSON ConfOutputType where
                 pure $ SummaryOutput $ SummaryParams soTemplate
             (String "block") -> do
                 boReport <- o .: "report"
-                let boParams = BlockParams
+                maxLength <- o .: "maxLength"
+                unicode <- o .: "unicode"
+                let boParams = def & bpMaxLength ??~ maxLength
+                                   & bpUnicode ??~ unicode
                 pure $ BlockOutput {..}
             other -> fail $ "Unsupported output type: " ++ show other
 

src/OrgStat/Outputs/Block.hs

@@ -6,29 +6,64 @@ module OrgStat.Outputs.Block
        ) where
 
 import           Universum
+import           Unsafe                 (unsafeLast)
 
-import qualified Data.Text             as T
+import qualified Data.Text              as T
+import           Text.PrettyPrint.Boxes (center1, hsep, left, render, right, text, vcat)
 
-import           OrgStat.Ast           (Org, filterHasClock, orgTitle, orgTotalDuration,
-                                        traverseTree)
-import           OrgStat.Outputs.Types (BlockOutput (..), BlockParams)
-import           OrgStat.Util          (timeF)
+import           OrgStat.Ast            (Org, filterHasClock, orgSubtrees, orgTitle,
+                                         orgTotalDuration)
+import           OrgStat.Outputs.Types  (BlockOutput (..), BlockParams (..))
+import           OrgStat.Util           (dropEnd, timeF)
 
--- Stub. Used for debug mostly.
+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 _ (filterHasClock -> o0) = do
-    BlockOutput $ T.unlines $ map formatter (o0 ^.. traverseTree)
+genBlockOutput BlockParams{..} (filterHasClock -> o0) = do
+    BlockOutput $ fromString $ render $
+        hsep 2 center1 [vsep,col1,vsep,col2,vsep]
   where
-    -- todo implement it with boxes package instead, this is just as stub
-    cutLen = 50
-    margin = 2
-    genPad n = fromString (replicate n ' ')
+    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 cutLen $ o ^. orgTitle
-            padding = cutLen - length titleRaw
-            titlePadded = titleRaw <> genPad padding
-        in mconcat [ titlePadded
-                   , genPad margin <> " | " <> genPad margin
-                   , timeF dur
-                   ]
+            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 (unsafeLast children)]
+        (name,dur) : childrenProcessed

src/OrgStat/Outputs/Types.hs

@@ -16,6 +16,8 @@ module OrgStat.Outputs.Types
        , SummaryOutput (..)
 
        , BlockParams (..)
+       , bpMaxLength
+       , bpUnicode
        , BlockOutput (..)
        ) where
 
@@ -93,8 +95,15 @@ newtype SummaryOutput = SummaryOutput Text
 
 -- | Parameters for block output. Stub (for now).
 data BlockParams = BlockParams
-    {
+    { _bpMaxLength :: Int
+      -- ^ Maximum title length (together with indentation).
+    , _bpUnicode   :: Bool
     } deriving (Show)
 
+makeLenses ''BlockParams
+
+instance Default BlockParams where
+    def = BlockParams 80 True
+
 -- | Output of block type is text file, basically.
 newtype BlockOutput = BlockOutput Text

test/GlobalSpec.hs

@@ -8,7 +8,7 @@ import qualified Data.Text             as T
 import           Data.Text.Arbitrary   ()
 import           Data.Time             (LocalTime (..), TimeOfDay (..), getZonedTime,
                                         zonedTimeToLocalTime)
-import           Data.Time.Calendar    (addGregorianMonthsRollOver, fromGregorian)
+import           Data.Time.Calendar    (addGregorianMonthsClip, fromGregorian)
 import           Test.Hspec            (Spec, describe, runIO)
 import           Test.Hspec.QuickCheck (prop)
 import           Test.QuickCheck       (Arbitrary (arbitrary), Gen, NonNegative (..),
@@ -106,7 +106,7 @@ convertRangeSpec = describe "Logic#convertRange" $ do
     curTime <- runIO $ zonedTimeToLocalTime <$> getZonedTime
     let subDays a i = (negate i * 60 * 60 * 24) `addLocalTime` a
     let subWeeks a i = (negate i * 60 * 60 * 24 * 7) `addLocalTime` a
-    let subMonths a i = a { localDay = (negate i) `addGregorianMonthsRollOver` (localDay a) }
+    let subMonths a i = a { localDay = (negate i) `addGregorianMonthsClip` (localDay a) }
     let inRange c (a,b) = c >= a && c <= b
     let convert = liftIO . convertRange
     prop "(now-1h, now) is correctly parsed" $