diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/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. diff --git a/orgstat.cabal b/orgstat.cabal --- a/orgstat.cabal +++ b/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 , Zhenya Vinogradov maintainer: volhovm.cs@gmail.com @@ -29,6 +30,7 @@ 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 diff --git a/src/OrgStat/Config.hs b/src/OrgStat/Config.hs --- a/src/OrgStat/Config.hs +++ b/src/OrgStat/Config.hs @@ -26,9 +26,9 @@ 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 @@ 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 diff --git a/src/OrgStat/Outputs/Block.hs b/src/OrgStat/Outputs/Block.hs --- a/src/OrgStat/Outputs/Block.hs +++ b/src/OrgStat/Outputs/Block.hs @@ -6,29 +6,64 @@ ) 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 diff --git a/src/OrgStat/Outputs/Summary.hs b/src/OrgStat/Outputs/Summary.hs --- a/src/OrgStat/Outputs/Summary.hs +++ b/src/OrgStat/Outputs/Summary.hs @@ -9,7 +9,7 @@ import Control.Lens (views) import qualified Data.Attoparsec.ByteString.Char8 as A -import OrgStat.Ast (orgTotalDuration) +import OrgStat.Ast (filterHasClock, orgTotalDuration) import OrgStat.Config (confReports, crName) import OrgStat.Helpers (resolveReport) import OrgStat.Outputs.Types (SummaryOutput (..), SummaryParams (..)) @@ -49,6 +49,6 @@ res <- fmap mconcat $ forM tokens $ \case OtherInfo t -> pure t ReportTemplate reportName -> do - report <- resolveReport reportName + report <- filterHasClock <$> resolveReport reportName pure $ timeF $ orgTotalDuration report pure $ SummaryOutput res diff --git a/src/OrgStat/Outputs/Timeline.hs b/src/OrgStat/Outputs/Timeline.hs --- a/src/OrgStat/Outputs/Timeline.hs +++ b/src/OrgStat/Outputs/Timeline.hs @@ -102,25 +102,26 @@ where toTake = floor $ n * ((params ^. tpColumnWidth) ** 1.2) +-- rectangle with origin in the top-left corner +topLeftRect :: Double -> Double -> D.Diagram B +topLeftRect w h = + D.rect w h + & D.moveOriginTo (D.p2 (-w/2, h/2)) + -- timeline for a single day timelineDay :: TimelineParams -> Day -> [(Text, (DiffTime, DiffTime))] -> D.Diagram B timelineDay params day clocks = - (D.strutY 5 D.===) $ - (dateLabel D.===) $ - D.scaleUToY height $ - (timeticks D.|||) $ mconcat - [ mconcat (map showClock clocks) - , background + [ timeticks + , dateLabel + , mconcat (map showClock clocks) + , clocksBackground ] where - width = 140 * (totalHeight / height) * (params ^. tpColumnWidth) - ticksWidth = 20 * (totalHeight / height) + width = 140 * (params ^. tpColumnWidth) + ticksWidth = 20 height = 700 * (params ^. tpColumnHeight) - totalHeight :: Double - totalHeight = 24*60 - timeticks :: D.Diagram B timeticks = mconcat $ @@ -129,30 +130,31 @@ [ D.alignedText 0.5 1 (show hour) & D.font "DejaVu Sans" & D.fontSize 8 - & D.moveTo (D.p2 (0, -5)) - , D.rect ticksWidth 1 - & D.lw D.none + & D.moveTo (D.p2 (ticksWidth/2, -5)) + & D.fc (D.sRGB24 150 150 150) + , D.strokeT (D.p2 (0,0) D.~~ (D.p2 (ticksWidth, 0))) + & D.translateY (-0.5) + & D.lwO 1 + & D.lc (D.sRGB24 200 200 200) ] - & D.fc (D.sRGB24 150 150 150) - & D.moveTo (D.p2 (0, totalHeight - fromIntegral hour * 60)) + & D.moveTo (D.p2 (0, negate $ fromInteger . round $ height * (fromIntegral hour / 24))) + & D.moveOriginTo (D.p2 (ticksWidth, 0)) dateLabel :: D.Diagram B dateLabel = mconcat [ D.strutY 20 - , D.alignedText 0 0.65 (formatTime defaultTimeLocale "%a, %d.%m.%Y" day) + , D.alignedText 0.5 0 (formatTime defaultTimeLocale "%a, %d.%m.%Y" day) & D.font "DejaVu Sans" & D.fontSize 12 - & D.moveTo (D.p2 (25, 0)) + & D.moveOriginTo (D.p2 (-width/2, 0)) ] - background :: D.Diagram B - background = - D.rect width totalHeight + clocksBackground :: D.Diagram B + clocksBackground = + topLeftRect width height & D.lw D.none & D.fc (params ^. tpBackground) - & D.moveOriginTo (D.p2 (-width/2, totalHeight/2)) - & D.moveTo (D.p2 (0, totalHeight)) contrastFrom c = if luminance c < 0.14 then D.sRGB24 224 224 224 else D.black @@ -160,19 +162,21 @@ showClock (label, (start, end)) = let w = width - h = fromInteger $ diffTimeMinutes $ end - start + h = (* height) $ fromInteger (diffTimeMinutes $ end - start) / (24*60) + y = (* height) $ fromInteger (diffTimeMinutes start) / (24*60) + bgboxColour = labelColour params label - bgbox = D.rect w h - & D.lw D.none - & D.fc bgboxColour + bgbox = topLeftRect w h + & D.lw D.none + & D.fc bgboxColour label' = D.alignedText 0 0.5 (T.unpack $ fitLabelWidth params 21 label) & D.font "DejaVu Sans" & D.fontSize 10 & D.fc (contrastFrom bgboxColour) - & D.moveTo (D.p2 (-w/2+10, 0)) + & D.moveTo (D.p2 (5, -h/2)) box = mconcat $ bool [] [label'] (fitLabelHeight params 14 h) ++ [bgbox] - in box & D.moveOriginTo (D.p2 (-w/2, h/2)) - & D.moveTo (D.p2 (0, totalHeight - fromInteger (diffTimeMinutes start))) + in box & D.moveTo (D.p2 (0, -y)) + -- timelines for several days, with top lists timelineDays :: TimelineParams @@ -181,6 +185,7 @@ -> [[(Text, DiffTime)]] -> D.Diagram B timelineDays params days clocks topLists = + (D.strutY 10 D.===) $ D.hcat $ flip map (days `zip` (clocks `zip` topLists)) $ \(day, (dayClocks, topList)) -> D.vsep 5 @@ -198,7 +203,7 @@ [ D.alignedText 1 0.5 (showTime time) & D.font "DejaVu Sans" & D.fontSize 10 - & D.translateX 30 + & D.translateX 20 , D.rect 12 12 & D.fc (labelColour params label) & D.lw D.none diff --git a/src/OrgStat/Outputs/Types.hs b/src/OrgStat/Outputs/Types.hs --- a/src/OrgStat/Outputs/Types.hs +++ b/src/OrgStat/Outputs/Types.hs @@ -16,6 +16,8 @@ , SummaryOutput (..) , BlockParams (..) + , bpMaxLength + , bpUnicode , BlockOutput (..) ) where @@ -93,8 +95,15 @@ -- | 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 diff --git a/src/OrgStat/Parser.hs b/src/OrgStat/Parser.hs --- a/src/OrgStat/Parser.hs +++ b/src/OrgStat/Parser.hs @@ -51,11 +51,19 @@ , _orgSubtrees = map convertHeading $ O.subHeadlines headline } + mapEither :: (a -> Either e b) -> ([a] -> [b]) + mapEither f xs = rights $ map f xs + getClocks :: O.Section -> [Clock] getClocks section = - mapMaybe convertClock $ - O.sectionClocks section <> - O.unLogbook (O.sectionLogbook section) + mapMaybe convertClock $ concat + [ O.sectionClocks section + , O.unLogbook (O.sectionLogbook section) + , mapEither (A.parseOnly O.parseClock) $ concat + [ concatMap lines $ map O.contents $ O.sectionDrawers section + , lines $ O.sectionParagraph section + ] + ] -- convert clocks from orgmode-parse format, returns Nothing for clocks -- without end time or time-of-day diff --git a/test/GlobalSpec.hs b/test/GlobalSpec.hs --- a/test/GlobalSpec.hs +++ b/test/GlobalSpec.hs @@ -8,7 +8,7 @@ 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 @@ 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" $