orgstat 0.1.5 → 0.1.6
raw patch · 10 files changed
+178/−92 lines, 10 filesdep +processdep −lineardep ~fmtdep ~orgmode-parse
Dependencies added: process
Dependencies removed: linear
Dependency ranges changed: fmt, orgmode-parse
Files
- CHANGES.md +16/−1
- orgstat.cabal +5/−4
- src/OrgStat/CLI.hs +2/−2
- src/OrgStat/Config.hs +36/−31
- src/OrgStat/Logic.hs +24/−16
- src/OrgStat/Outputs.hs +1/−0
- src/OrgStat/Outputs/Script.hs +49/−0
- src/OrgStat/Outputs/Types.hs +17/−26
- src/OrgStat/Parser.hs +23/−7
- src/OrgStat/Scope.hs +5/−5
CHANGES.md view
@@ -1,5 +1,20 @@-0.1.5+0.1.6 ==========+* Support "or" tags -- now it's possible to specify "t1 | t2 | t3" as a modifier by+ providing a list of tags in config.+* Support of file-level tags: "#+FILETAGS: :tagA:tagB:tagC:" is correctly parsed+ and tags are propagated to all the file tree headers.+* Added new output type -- script output.+* Improved documentation, in particular in the orgstatExample.yaml.+* Breaking: Configuration changes:+ * Simplifed the configuration, now there's only one default timeline config,+ which cannot be overriden on a per-output basis.+ * Config parameter `colorSalt` was removed, use `timelineDefault.colorSalt` instead.+ * Timeline default color is now white.+ * timelineDefault renamed into timelineParams.++0.1.5+===== * Support selecting multiple outputs in cli: --select-output can be used several times, also it's renamed into --output.
orgstat.cabal view
@@ -1,5 +1,5 @@ name: orgstat-version: 0.1.5+version: 0.1.6 synopsis: Statistics visualizer for org-mode license: GPL-3 license-file: LICENSE@@ -24,6 +24,7 @@ , OrgStat.Outputs.Block , OrgStat.Outputs.Class , OrgStat.Outputs.Summary+ , OrgStat.Outputs.Script , OrgStat.Outputs.Timeline , OrgStat.Outputs.Types , OrgStat.Util@@ -44,13 +45,13 @@ , exceptions >= 0.8.3 , filepath , formatting- , fmt+ , fmt >= 0.6 , hashable >= 1.2.4.0 , lens >= 4.14- , linear , mtl >= 2.2.1 , optparse-simple- , orgmode-parse >= 0.2.1+ , orgmode-parse >= 0.2.1 && < 0.3+ , process >= 1.6.3.0 , text >= 1.2.2.1 , time >= 1.6.0.1 , turtle >= 1.2.8
src/OrgStat/CLI.hs view
@@ -29,9 +29,9 @@ strOption (long "output" <> long "select-output" <> help ("Output name(s) you want to process " <>- "(by default all outputs from conf are selected)"))) <*>+ "(default: all outputs are processed)"))) <*> optional ( strOption (long "output-dir" <> metavar "FILEPATH" <> help ("Final output directory that overrides one in config. " <>- "No extra subdirectories will be created!")))+ "No extra subdirectories will be created")))
src/OrgStat/Config.hs view
@@ -18,18 +18,16 @@ import Data.Aeson (FromJSON (..), Value (Object, String), withObject, withText, (.!=), (.:), (.:?)) import Data.Aeson.Types (typeMismatch)-import Data.Default (def) import Data.List.NonEmpty (NonEmpty) import qualified Data.Text as T import Data.Time (LocalTime) import Data.Time.Format (defaultTimeLocale, parseTimeM) import Universum -import OrgStat.Outputs.Types (BlockParams, SummaryParams (..), TimelineParams, bpMaxLength,- bpUnicode, tpBackground, tpColumnHeight, tpColumnWidth, tpLegend,- tpTopDay)+import OrgStat.Outputs.Types (BlockParams (..), ScriptParams (..), SummaryParams (..),+ TimelineParams (..)) import OrgStat.Scope (AstPath (..), ScopeModifier (..))-import OrgStat.Util (parseColour, (??~))+import OrgStat.Util (parseColour) -- | Exception type for everything bad that happens with config, -- starting from parsing to logic errors.@@ -56,6 +54,7 @@ = TimelineOutput { toParams :: !TimelineParams , toReport :: !Text } | SummaryOutput !SummaryParams+ | ScriptOutput !ScriptParams | BlockOutput { boParams :: !BlockParams , boReport :: !Text } deriving (Show)@@ -78,13 +77,12 @@ } deriving (Show) data OrgStatConfig = OrgStatConfig- { confScopes :: ![ConfScope]- , confReports :: ![ConfReport]- , confOutputs :: ![ConfOutput]- , confBaseTimelineParams :: !TimelineParams- , confTodoKeywords :: ![Text]- , confOutputDir :: !FilePath -- default is "./orgstat"- , confColorSalt :: !Int+ { confScopes :: ![ConfScope]+ , confReports :: ![ConfReport]+ , confOutputs :: ![ConfOutput]+ , confTimelineParams :: !TimelineParams+ , confTodoKeywords :: ![Text]+ , confOutputDir :: !FilePath -- default is "./orgstat" } deriving (Show) instance FromJSON AstPath where@@ -96,7 +94,9 @@ o .: "type" >>= \case (String "prune") -> ModPruneSubtree <$> o .: "path" <*> o .:? "depth" .!= 0 (String "select") -> ModSelectSubtree <$> o .: "path"- (String "filterbytag") -> ModFilterTag <$> o .: "tag"+ (String "filterbytag") ->+ (ModFilterTags . (\x -> [x]) <$> o .: "tag") <|>+ (ModFilterTags <$> o .: "tags") other -> fail $ "Unsupported scope modifier type: " ++ show other instance FromJSON ConfDate where@@ -134,16 +134,15 @@ instance FromJSON TimelineParams where parseJSON = withObject "TimelineParams" $ \v -> do- legend <- v .:? "legend"- topDay <- v .:? "topDay"- colWidth <- v .:? "colWidth"- colHeight <- v .:? "colHeight"- bgColorRaw <- v .:? "background"- pure $ def & tpLegend ??~ legend- & tpTopDay ??~ topDay- & tpColumnWidth ??~ colWidth- & tpColumnHeight ??~ colHeight- & tpBackground ??~ (T.strip <$> bgColorRaw >>= parseColour @Text)+ _tpColorSalt <- v .:? "colorSalt" .!= 0+ _tpLegend <- v .:? "legend" .!= True+ _tpTopDay <- v .:? "topDay" .!= 5+ _tpColumnWidth <- v .:? "colWidth" .!= 1.0+ _tpColumnHeight <- v .:? "colHeight" .!= 1.0+ _tpBackground <-+ (fromMaybe (error "Can't parse colour") . parseColour @Text . T.strip) <$>+ v .:? "background" .!= "#ffffff"+ pure TimelineParams{..} instance FromJSON ConfOutputType where parseJSON = withObject "ConfOutputType" $ \o ->@@ -155,19 +154,24 @@ (String "summary") -> do soTemplate <- o .: "template" pure $ SummaryOutput $ SummaryParams soTemplate+ (String "script") -> do+ spScript <-+ fmap Left (o .: "scriptPath") <|>+ fmap Right (o .: "inline")+ spReports <- o .: "reports"+ pure $ ScriptOutput $ ScriptParams spScript spReports (String "block") -> do boReport <- o .: "report"- maxLength <- o .: "maxLength"- unicode <- o .: "unicode"- let boParams = def & bpMaxLength ??~ maxLength- & bpUnicode ??~ unicode+ _bpMaxLength <- o .:? "maxLength" .!= 80+ _bpUnicode <- o .:? "unicode" .!= True+ let boParams = BlockParams{..} pure $ BlockOutput {..} other -> fail $ "Unsupported output type: " ++ show other instance FromJSON ConfOutput where parseJSON = withObject "ConfOutput" $ \o -> do- coName <- o .: "name"- coType <- parseJSON (Object o)+ coName <- o .: "name"+ coType <- parseJSON (Object o) pure $ ConfOutput{..} instance FromJSON ConfScope where@@ -187,7 +191,8 @@ OrgStatConfig <$> o .: "scopes" <*> o .: "reports" <*> o .: "outputs"- <*> o .:? "timelineDefault" .!= def+ -- timelineDefault is deprecated+ <*> ((o .: "timelineParams" <|> o .: "timelineDefault")+ <|> parseJSON (Object mempty)) <*> o .:? "todoKeywords" .!= [] <*> (o .:? "outputDir" <|> o .:? "output") .!= "./orgstat"- <*> o .:? "colorSalt" .!= 0
src/OrgStat/Logic.hs view
@@ -19,7 +19,8 @@ import OrgStat.Config (ConfOutput (..), ConfOutputType (..), OrgStatConfig (..)) import OrgStat.Helpers (resolveOutput, resolveReport) import OrgStat.Logging (logDebug, logInfo)-import OrgStat.Outputs (genBlockOutput, genSummaryOutput, processTimeline, tpColorSalt, writeReport)+import OrgStat.Outputs (genBlockOutput, genSummaryOutput, processScriptOutput, processTimeline,+ writeReport) import OrgStat.WorkMonad (WorkM, wcCommonArgs, wcConfig) -- | Main application logic.@@ -29,37 +30,44 @@ logDebug $ "Config: \n" <> show conf curTime <- liftIO getZonedTime-- let createDir = do- let reportDir = confOutputDir </>+ let getOutputDir = do+ let createDir = do+ let reportDir =+ confOutputDir </> formatTime defaultTimeLocale "%F-%H-%M-%S" curTime- liftIO $ createDirectoryIfMissing True reportDir- pure reportDir- reportDir <- maybe createDir pure =<< views wcCommonArgs caOutputDir- logInfo $ "This report set will be put into: " <> fromString reportDir+ liftIO $ createDirectoryIfMissing True reportDir+ pure reportDir+ maybe createDir pure =<< views wcCommonArgs caOutputDir+ let writeOutput coName res = do+ reportDir <- getOutputDir+ let prePath = reportDir </> T.unpack coName+ logInfo $ "This output will be written into: " <> fromString reportDir+ writeReport prePath res cliOuts <- views wcCommonArgs caOutputs outputsToProcess <- bool (mapM resolveOutput cliOuts) (pure confOutputs) (null cliOuts)+ forM_ outputsToProcess $ \ConfOutput{..} -> do logInfo $ "Processing output " <> coName- let prePath = reportDir </> T.unpack coName case coType of TimelineOutput {..} -> do resolved <- resolveReport toReport- let timelineParamsFinal =- (confBaseTimelineParams <> toParams) & tpColorSalt .~ confColorSalt- let res = processTimeline timelineParamsFinal resolved- logInfo $ "Generating timeline report " <> coName <> "..."- writeReport prePath res+ let timeline = processTimeline confTimelineParams resolved+ logDebug $ "Generating timeline report " <> coName <> "..."+ writeOutput coName timeline SummaryOutput params -> do summary <- genSummaryOutput params- writeReport prePath summary+ writeOutput coName summary+ ScriptOutput params ->+ processScriptOutput params BlockOutput {..} -> do resolved <- resolveReport boReport let res = genBlockOutput boParams resolved- writeReport prePath res+ writeOutput coName res+ whenM (views wcCommonArgs caXdgOpen) $ do+ reportDir <- getOutputDir logInfo "Opening reports using xdg-open..." void $ shell ("for i in $(ls "<>T.pack reportDir<>"/*); do xdg-open $i; done") empty logInfo "Done"
src/OrgStat/Outputs.hs view
@@ -6,6 +6,7 @@ import OrgStat.Outputs.Block as Exports import OrgStat.Outputs.Class as Exports+import OrgStat.Outputs.Script as Exports import OrgStat.Outputs.Summary as Exports import OrgStat.Outputs.Timeline as Exports import OrgStat.Outputs.Types as Exports
+ src/OrgStat/Outputs/Script.hs view
@@ -0,0 +1,49 @@+-- | Script output type. We launch the executable asked after+-- injecting the environment variables related to the report.++module OrgStat.Outputs.Script+ ( processScriptOutput+ ) where++import Universum++import Control.Lens (views)+import qualified Data.Map.Strict as M+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.Process (callCommand)++import OrgStat.Ast (filterHasClock, orgTotalDuration)+import OrgStat.Config (confReports, crName)+import OrgStat.Helpers (resolveReport)+import OrgStat.Outputs.Types (ScriptParams (..))+import OrgStat.Util (timeF)+import OrgStat.WorkMonad (WorkM, wcConfig)++-- | Processes script output.+processScriptOutput :: ScriptParams -> WorkM ()+processScriptOutput ScriptParams{..} = do+ -- Considering all the reports if none are specified.+ reportsToConsider <- case spReports of+ [] -> views wcConfig (map crName . confReports)+ xs -> pure xs+ allReports <- mapM (\r -> (r,) <$> resolveReport r) reportsToConsider++ -- Set env variables+ prevVars <- forM allReports $ \(toString -> reportName,org) -> do+ let duration = timeF $ orgTotalDuration $ filterHasClock org+ (prevVar :: Maybe String) <- liftIO $ lookupEnv reportName+ liftIO $ setEnv reportName (toString duration)+ pure $ (reportName,) <$> prevVar+ let prevVarsMap :: Map String String+ prevVarsMap = M.fromList $ catMaybes prevVars++ -- Execute script+ let cmdArgument = either id (\t -> "-c \"" <> toString t <> "\"") spScript+ liftIO $ callCommand $+ "sh " <> cmdArgument++ -- Restore the old variables, clean new.+ forM_ (map fst allReports) $ \(toString -> reportName) -> do+ liftIO $ case M.lookup reportName prevVarsMap of+ Nothing -> unsetEnv reportName+ Just prevValue -> setEnv reportName prevValue
src/OrgStat/Outputs/Types.hs view
@@ -15,6 +15,8 @@ , SummaryParams (..) , SummaryOutput (..) + , ScriptParams (..)+ , BlockParams (..) , bpMaxLength , bpUnicode@@ -48,33 +50,9 @@ -- ^ Color of background } deriving (Show) -instance Default TimelineParams where- def = TimelineParams 0 True 5 1 1 (D.sRGB24 0xf2 0xf2 0xf2)- makeLenses ''TimelineParams --- | For all non-default field values of RHS, override LHS with them.-mergeParams :: TimelineParams -> TimelineParams -> TimelineParams-mergeParams lhs rhs = mods lhs- where- mods = foldr1 (.)- [ asId tpColorSalt- , asId tpLegend- , asId tpTopDay- , asId tpColumnWidth- , asId tpColumnHeight- , asId tpBackground ]- asId :: forall b. (Eq b) => Lens' TimelineParams b -> TimelineParams -> TimelineParams- asId l x =- if def ^. l == rhs ^. l- then x else x & l .~ (rhs ^. l) -instance Semigroup TimelineParams where- (<>) = mergeParams----instance Monoid TimelineParams where--- mempty = def- -- | SVG timeline image. newtype TimelineOutput = TimelineOutput (D.Diagram B) @@ -92,14 +70,27 @@ newtype SummaryOutput = SummaryOutput Text ----------------------------------------------------------------------------+-- Script+----------------------------------------------------------------------------++-- | Parameters of the summary output+data ScriptParams = ScriptParams+ { spScript :: !(Either FilePath Text)+ -- ^ Either path to the script to execute, or a script text itself.+ , spReports :: ![Text]+ -- ^ Reports to consider.+ } deriving Show++---------------------------------------------------------------------------- -- Block ---------------------------------------------------------------------------- -- | Parameters for block output. Stub (for now). data BlockParams = BlockParams- { _bpMaxLength :: Int+ { _bpMaxLength :: !Int -- ^ Maximum title length (together with indentation).- , _bpUnicode :: Bool+ , _bpUnicode :: !Bool+ -- ^ Should unicode symbols be used for box borders. } deriving (Show) makeLenses ''BlockParams
src/OrgStat/Parser.hs view
@@ -10,13 +10,14 @@ import Control.Exception (Exception) import qualified Data.Attoparsec.Text as A+import Data.Char (isSpace) import qualified Data.OrgMode.Parse as O import qualified Data.OrgMode.Types as O import qualified Data.Text as T import Data.Time (LocalTime (..), TimeOfDay (..), fromGregorian, getZonedTime, zonedTimeToLocalTime) import Data.Time.Calendar () -import OrgStat.Ast (Clock (..), Org (..))+import OrgStat.Ast (Clock (..), Org (..), orgTags, traverseTree) ---------------------------------------------------------------------------- -- Exceptions@@ -36,12 +37,15 @@ parseOrg curTime todoKeywords = convertDocument <$> O.parseDocument todoKeywords where convertDocument :: O.Document -> Org- convertDocument (O.Document _ headings) = Org- { _orgTitle = ""- , _orgTags = []- , _orgClocks = []- , _orgSubtrees = map convertHeading headings- }+ convertDocument (O.Document textBefore headings) =+ let fileLvlTags = extractFileTags textBefore+ addTags t = ordNub $ fileLvlTags <> t+ o = Org { _orgTitle = ""+ , _orgTags = []+ , _orgClocks = []+ , _orgSubtrees = map convertHeading headings+ }+ in o & traverseTree . orgTags %~ addTags convertHeading :: O.Headline -> Org convertHeading headline = Org@@ -85,6 +89,18 @@ (fromGregorian (toInteger year) month day) (TimeOfDay hour minute 0) convertDateTime _ = Nothing++ extractFileTags (T.lines -> inputLines) =+ let prfx = "#+FILETAGS: "+ matching =+ map (T.drop (length prfx)) $+ (filter (prfx `T.isPrefixOf`) inputLines)+ toTags (T.strip -> line) =+ let parts = filter (not . T.null) $ T.splitOn ":" line+ -- Correct tag shouldn't contain spaces inside+ correctPart p = not $ T.any isSpace p+ in if all correctPart parts then parts else []+ in ordNub $ concatMap toTags matching -- Throw parsing exception if it can't be parsed (use Control.Monad.Catch#throwM) runParser :: (MonadIO m, MonadThrow m) => [Text] -> Text -> m Org
src/OrgStat/Scope.hs view
@@ -60,9 +60,9 @@ data ScopeModifier = ModPruneSubtree AstPath Int -- ^ Turns all subtrees starting with @path@ and then on depth @d@ into leaves.- | ModFilterTag Text- -- ^ Given text tag name, it leaves only those subtrees that- -- have this tag (tags are inherited).+ | ModFilterTags [Text]+ -- ^ Given text tag names, it leaves only those subtrees that+ -- have one of these tag (tags are inherited). | ModSquash AstPath -- ^ Starting at node on path A and depth n, turn A into set of -- nodes A/a1/a2/.../an. Doesn't work/make sense for empty path.@@ -96,8 +96,8 @@ pure $ fromMaybe (error "applyModifier@ModSelectSubtree is broken") $ org ^. atPath path-applyModifier (ModFilterTag tag) o0 = do- let matchesTag o = any (== tag) (o ^. orgTags)+applyModifier (ModFilterTags tags) o0 = do+ let matchesTag o = any (`elem` tags) (o ^. orgTags) let dfs :: Org -> Maybe Org dfs o | matchesTag o = Just o | otherwise = case mapMaybe dfs (o ^. orgSubtrees) of