orgstat 0.1.1 → 0.1.2
raw patch · 9 files changed
+157/−63 lines, 9 filesdep +boxes
Dependencies added: boxes
Files
- CHANGES.md +32/−0
- orgstat.cabal +3/−1
- src/OrgStat/Config.hs +7/−4
- src/OrgStat/Outputs/Block.hs +54/−19
- src/OrgStat/Outputs/Summary.hs +2/−2
- src/OrgStat/Outputs/Timeline.hs +36/−31
- src/OrgStat/Outputs/Types.hs +10/−1
- src/OrgStat/Parser.hs +11/−3
- test/GlobalSpec.hs +2/−2
+ CHANGES.md view
@@ -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.
orgstat.cabal view
@@ -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 <volhovm.cs@gmail.com>, Zhenya Vinogradov <zhenyavinogradov@gmail.com> 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
src/OrgStat/Config.hs view
@@ -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
src/OrgStat/Outputs/Block.hs view
@@ -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
src/OrgStat/Outputs/Summary.hs view
@@ -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
src/OrgStat/Outputs/Timeline.hs view
@@ -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
src/OrgStat/Outputs/Types.hs view
@@ -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
src/OrgStat/Parser.hs view
@@ -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
test/GlobalSpec.hs view
@@ -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" $