orgstat 0.1.4 → 0.1.5
raw patch · 15 files changed
+192/−78 lines, 15 filesdep +ansi-terminaldep +fmtdep −log-warperdep ~basedep ~universum
Dependencies added: ansi-terminal, fmt
Dependencies removed: log-warper
Dependency ranges changed: base, universum
Files
- CHANGES.md +8/−0
- orgstat.cabal +8/−7
- src/OrgStat/CLI.hs +8/−7
- src/OrgStat/IO.hs +8/−7
- src/OrgStat/Logging.hs +107/−0
- src/OrgStat/Logic.hs +5/−5
- src/OrgStat/Outputs/Block.hs +6/−6
- src/OrgStat/Outputs/Types.hs +5/−3
- src/OrgStat/Parser.hs +9/−6
- src/OrgStat/Scope.hs +5/−4
- src/OrgStat/Util.hs +1/−1
- src/OrgStat/WorkMonad.hs +0/−6
- src/cli/Main.hs +2/−3
- test/GlobalSpec.hs +17/−20
- test/Test.hs +3/−3
CHANGES.md view
@@ -1,3 +1,11 @@+0.1.5+==========++* Support selecting multiple outputs in cli: --select-output can be used several times,+ also it's renamed into --output.+* Remove log-warper dependency replacing with simple local logging.+* Update deps: universum-1.4.0, fmt-0.6, orgmode-parse-0.2.2, also update lts to 12.5+ 0.1.4 =====
orgstat.cabal view
@@ -1,5 +1,5 @@ name: orgstat-version: 0.1.4+version: 0.1.5 synopsis: Statistics visualizer for org-mode license: GPL-3 license-file: LICENSE@@ -16,6 +16,7 @@ , OrgStat.CLI , OrgStat.Helpers , OrgStat.IO+ , OrgStat.Logging , OrgStat.Logic , OrgStat.Parser , OrgStat.Scope@@ -30,7 +31,8 @@ , Paths_orgstat build-depends: aeson >= 0.11.2.0 , attoparsec- , base >=4.9 && <4.11+ , ansi-terminal+ , base >=4.11 && <4.12 , boxes >= 0.1.4 , bytestring , colour >= 2.3.3@@ -42,17 +44,17 @@ , exceptions >= 0.8.3 , filepath , formatting+ , fmt , hashable >= 1.2.4.0 , lens >= 4.14 , linear- , log-warper >= 1.7.1 , mtl >= 2.2.1 , optparse-simple , orgmode-parse >= 0.2.1 , text >= 1.2.2.1 , time >= 1.6.0.1 , turtle >= 1.2.8- , universum >= 0.8.0+ , universum >= 1.4.0 , yaml >= 0.8.21.1 hs-source-dirs: src default-language: Haskell2010@@ -76,13 +78,12 @@ executable orgstat main-is: Main.hs other-modules: Paths_orgstat- build-depends: base >=4.9 && <4.11+ build-depends: base , bytestring , directory , exceptions , filepath , formatting- , log-warper , optparse-simple , orgstat , universum@@ -101,7 +102,7 @@ , GlobalSpec build-depends: HUnit >= 1.3.1.2 , QuickCheck- , base >=4.9 && <4.11+ , base , colour >= 2.3.3 , hspec , orgstat
src/OrgStat/CLI.hs view
@@ -12,11 +12,11 @@ -- | Read-only arguments that inner application needs (in contrast to, -- say, logging severity). data CommonArgs = CommonArgs- { xdgOpen :: !Bool+ { caXdgOpen :: !Bool -- ^ Open report types using xdg-open- , selectOutput :: !(Maybe Text)+ , caOutputs :: ![Text] -- ^ Single output can be selected instead of running all of them.- , outputDir :: !(Maybe FilePath)+ , caOutputDir :: !(Maybe FilePath) -- ^ Output directory for all ... outputs. } deriving Show @@ -24,11 +24,12 @@ parseCommonArgs = CommonArgs <$> switch (long "xdg-open" <> help "Open each report using xdg-open") <*>- optional (+ many ( fromString <$>- strOption (long "select-output" <>- help ("Output name you want to process " <>- "(by default all outputs from conf are processed"))) <*>+ strOption (long "output" <>+ long "select-output" <>+ help ("Output name(s) you want to process " <>+ "(by default all outputs from conf are selected)"))) <*> optional ( strOption (long "output-dir" <> metavar "FILEPATH" <>
src/OrgStat/IO.hs view
@@ -7,19 +7,20 @@ , readConfig ) where -import qualified Base as Base+import qualified Prelude+import Universum+ import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.IO as TIO-import Data.Yaml (decodeEither)+import Data.Yaml (decodeEither') import System.Directory (doesFileExist) import System.FilePath (takeBaseName, takeExtension)-import System.Wlog (WithLogger, logDebug) import Turtle (ExitCode (..), procStrict)-import Universum import OrgStat.Ast (Org) import OrgStat.Config (ConfigException (ConfigParseException), OrgStatConfig)+import OrgStat.Logging import OrgStat.Parser (runParser) import OrgStat.Util (dropEnd) @@ -30,7 +31,7 @@ -- ^ Failed to run some external app (gpg) deriving (Typeable) -instance Base.Show OrgIOException where+instance Show OrgIOException where show (OrgIOException r) = "IOException: " <> T.unpack r show (ExternalException r) = "ExternalException: " <> T.unpack r @@ -40,7 +41,7 @@ -- decrypt it first. Returns a pair @(filename, content)@. It also -- takes a list of TODO-keywords to take header names correctly. readOrgFile- :: (MonadIO m, MonadCatch m, WithLogger m)+ :: (MonadIO m, MonadCatch m) => [Text] -> FilePath -> m (Text, Org) readOrgFile todoKeywords fp = do logDebug $ "Reading org file " <> fpt@@ -75,6 +76,6 @@ unlessM (liftIO $ doesFileExist fp) $ throwM $ OrgIOException $ "Config file " <> fpt <> " doesn't exist" res <- liftIO $ BS.readFile fp- either (throwM . ConfigParseException . T.pack) pure $ decodeEither res+ either (throwM . ConfigParseException . show) pure $ decodeEither' res where fpt = T.pack fp
+ src/OrgStat/Logging.hs view
@@ -0,0 +1,107 @@+-- | Basic logging, copied from log-warper (it has too many+-- dependencies).+module OrgStat.Logging+ (+ Severity (..)+ , initLogging++ , logDebug+ , logInfo+ , logNotice+ , logWarning+ , logError++ , logMessage+ ) where++import Universum++import Control.Concurrent.MVar (modifyMVar_, withMVar)+import qualified Data.Text as T+import Data.Time.Clock (UTCTime (..), getCurrentTime)+import Fmt (fmt, padRightF, (+|), (|+), (|++|))+import Fmt.Time (dateDashF, hmsF, subsecondF, tzNameF)+import System.Console.ANSI (Color (Blue, Green, Magenta, Red, Yellow), ColorIntensity (Vivid),+ ConsoleLayer (Foreground), SGR (Reset, SetColor), setSGRCode)+import System.IO.Unsafe (unsafePerformIO)+++-- | Severity is level of log message importance. It uniquely+-- determines which messages to print.+data Severity+ = Debug -- ^ Debug messages+ | Info -- ^ Information+ | Notice -- ^ Important (more than average) information+ | Warning -- ^ General warnings+ | Error -- ^ General errors/severe errors+ deriving (Eq, Ord, Show)++-- | Internal information about logging.+data LogInternalState = LogInternalState+ { lisMinSeverity :: Severity+ } deriving Show++-- | Internal logging state.+{-# NOINLINE loggingState #-}+loggingState :: MVar LogInternalState+loggingState = unsafePerformIO $ newMVar $ LogInternalState Debug++-- | Initialise logging state.+initLogging :: Severity -> IO ()+initLogging sev = modifyMVar_ loggingState $ const $ pure $ LogInternalState sev++-- | Colorizes "Text".+colorizer :: Severity -> Text -> Text+colorizer pr s =+ let (before, after) = table pr+ in toText before <> s <> toText after+ where+ -- | Defines pre- and post-printed characters for printing colorized text.+ table :: Severity -> (String, String)+ table severity = case severity of+ Error -> (setColor Red , reset)+ Debug -> (setColor Green , reset)+ Notice -> (setColor Magenta , reset)+ Warning -> (setColor Yellow , reset)+ Info -> (setColor Blue , reset)+ where+ setColor color = setSGRCode [SetColor Foreground Vivid color]+ reset = setSGRCode [Reset]++-- | Formats UTC time in next format: "%Y-%m-%d %H:%M:%S%Q %Z"+-- but %Q part show only in centiseconds (always 2 digits).+centiUtcTimeF :: UTCTime -> Text+centiUtcTimeF t =+ dateDashF t |+ " " +| hmsF t |++| centiSecondF t |+ " " +| tzNameF t |+ ""+ where+ centiSecondF = padRightF 3 '0' . T.take 3 . fmt . subsecondF++-- | Logs message with specified severity using logger name in context.+logMessage+ :: (MonadIO m)+ => Severity+ -> Text+ -> m ()+logMessage severity msg =+ liftIO $ withMVar loggingState $ \LogInternalState{..} -> do+ time <- liftIO $ getCurrentTime+ let text = format time+ when (severity >= lisMinSeverity) $ putStrLn text+ where+ format time = mconcat+ [ colorizer severity $ "[" <> show severity <> "]"+ , " ["+ , centiUtcTimeF time+ , "] "+ , msg+ ]++-- | Shortcuts for 'logMessage' to use according severity.+logDebug, logInfo, logNotice, logWarning, logError+ :: MonadIO m+ => Text -> m ()+logDebug = logMessage Debug+logInfo = logMessage Info+logNotice = logMessage Notice+logWarning = logMessage Warning+logError = logMessage Error
src/OrgStat/Logic.hs view
@@ -13,12 +13,12 @@ import Data.Time (defaultTimeLocale, formatTime, getZonedTime) import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>))-import System.Wlog (logDebug, logInfo) import Turtle (shell) import OrgStat.CLI (CommonArgs (..)) 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.WorkMonad (WorkM, wcCommonArgs, wcConfig) @@ -35,12 +35,12 @@ formatTime defaultTimeLocale "%F-%H-%M-%S" curTime liftIO $ createDirectoryIfMissing True reportDir pure reportDir- reportDir <- maybe createDir pure =<< views wcCommonArgs outputDir+ reportDir <- maybe createDir pure =<< views wcCommonArgs caOutputDir logInfo $ "This report set will be put into: " <> fromString reportDir + cliOuts <- views wcCommonArgs caOutputs outputsToProcess <-- maybe (pure confOutputs) (fmap one . resolveOutput) =<<- views wcCommonArgs selectOutput+ bool (mapM resolveOutput cliOuts) (pure confOutputs) (null cliOuts) forM_ outputsToProcess $ \ConfOutput{..} -> do logInfo $ "Processing output " <> coName let prePath = reportDir </> T.unpack coName@@ -59,7 +59,7 @@ resolved <- resolveReport boReport let res = genBlockOutput boParams resolved writeReport prePath res- whenM (views wcCommonArgs xdgOpen) $ do+ whenM (views wcCommonArgs caXdgOpen) $ do 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/Block.hs view
@@ -6,8 +6,8 @@ ) where import Universum-import Unsafe (unsafeLast) +import qualified Data.List as L import qualified Data.Text as T import Text.PrettyPrint.Boxes (center1, hsep, left, render, right, text, vcat) @@ -34,10 +34,10 @@ where 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)+ 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@@ -64,5 +64,5 @@ | otherwise = concat $ map processChild (dropEnd 1 children) ++- [processLastChild (unsafeLast children)]+ [processLastChild (L.last children)] (name,dur) : childrenProcessed
src/OrgStat/Outputs/Types.hs view
@@ -69,9 +69,11 @@ if def ^. l == rhs ^. l then x else x & l .~ (rhs ^. l) -instance Monoid TimelineParams where- mempty = def- mappend = mergeParams+instance Semigroup TimelineParams where+ (<>) = mergeParams++--instance Monoid TimelineParams where+-- mempty = def -- | SVG timeline image. newtype TimelineOutput = TimelineOutput (D.Diagram B)
src/OrgStat/Parser.hs view
@@ -13,7 +13,7 @@ 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)+import Data.Time (LocalTime (..), TimeOfDay (..), fromGregorian, getZonedTime, zonedTimeToLocalTime) import Data.Time.Calendar () import OrgStat.Ast (Clock (..), Org (..))@@ -32,8 +32,8 @@ -- Parsing ---------------------------------------------------------------------------- -parseOrg :: [Text] -> A.Parser Org-parseOrg todoKeywords = convertDocument <$> O.parseDocument todoKeywords+parseOrg :: LocalTime -> [Text] -> A.Parser Org+parseOrg curTime todoKeywords = convertDocument <$> O.parseDocument todoKeywords where convertDocument :: O.Document -> Org convertDocument (O.Document _ headings) = Org@@ -70,6 +70,8 @@ convertClock :: O.Clock -> Maybe Clock convertClock (O.Clock (Just (O.Timestamp start _active (Just end)), _duration)) = Clock <$> convertDateTime start <*> convertDateTime end+ convertClock (O.Clock (Just (O.Timestamp start _active Nothing), _duration)) =+ Clock <$> convertDateTime start <*> pure curTime convertClock _ = Nothing -- Nothing for DateTime without time-of-day@@ -85,8 +87,9 @@ convertDateTime _ = Nothing -- Throw parsing exception if it can't be parsed (use Control.Monad.Catch#throwM)-runParser :: (MonadThrow m) => [Text] -> Text -> m Org-runParser todoKeywords t =- case A.parseOnly (parseOrg todoKeywords) t of+runParser :: (MonadIO m, MonadThrow m) => [Text] -> Text -> m Org+runParser todoKeywords t = do+ localTime <- liftIO $ zonedTimeToLocalTime <$> getZonedTime+ case A.parseOnly (parseOrg localTime todoKeywords) t of Left err -> throwM $ ParsingException $ T.pack err Right res -> pure res
src/OrgStat/Scope.hs view
@@ -13,11 +13,12 @@ , applyModifiers ) where -import qualified Base as Base+import qualified Prelude+import Universum+ import Control.Lens (to) import Control.Monad.Except (throwError) import qualified Data.Text as T-import Universum import OrgStat.Ast (Org, atDepth, orgClocks, orgSubtrees, orgTags, orgTitle, traverseTree) @@ -27,7 +28,7 @@ { getAstPath :: [Text] } deriving (Eq, Ord) -instance Base.Show AstPath where+instance Show AstPath where show (AstPath path) | null path = "<null_ast_path>" | otherwise = intercalate "/" (map T.unpack path)@@ -44,7 +45,7 @@ atPathDo (x:xs) org = let match = find ((== x) . view orgTitle) $ org ^. orgSubtrees modified foo = org & orgSubtrees %~ foo . filter ((/= match) . Just)- fmapFoo Nothing = modified identity+ fmapFoo Nothing = modified id fmapFoo (Just o') = modified (o' :) in case (xs,match) of (_,Nothing) -> f Nothing $> org
src/OrgStat/Util.hs view
@@ -80,7 +80,7 @@ -- | Maybe setter that does nothing on Nothing. (??~) :: ASetter s s a b -> Maybe b -> s -> s-(??~) _ Nothing = identity+(??~) _ Nothing = id (??~) l (Just k) = l .~ k -- | Time formatter in form HH:MM
src/OrgStat/WorkMonad.hs view
@@ -18,7 +18,6 @@ import Control.Lens (makeLenses) import Data.Default (Default (def))-import qualified System.Wlog as W import OrgStat.Ast (Org) import OrgStat.CLI (CommonArgs)@@ -57,14 +56,9 @@ , MonadIO , MonadReader WorkConfig , MonadState WorkData- , W.CanLog , MonadThrow , MonadCatch )--instance W.HasLoggerName WorkM where- askLoggerName = pure $ W.LoggerName "OrgStat"- modifyLoggerName _ = identity runWorkM :: MonadIO m => WorkConfig -> WorkM a -> m a runWorkM config action =
src/cli/Main.hs view
@@ -11,11 +11,10 @@ import Paths_orgstat (version) import System.Directory (getHomeDirectory) import System.FilePath ((</>))-import System.Wlog (Severity (..), logDebug, logError, productionB, setupLogging, severityPlus,- termSeveritiesOutB) import OrgStat.CLI (CommonArgs, parseCommonArgs) import OrgStat.IO (readConfig)+import OrgStat.Logging (Severity (..), initLogging, logDebug, logError) import OrgStat.Logic (runOrgStat) import OrgStat.WorkMonad (WorkConfig (..), runWorkM) @@ -53,7 +52,7 @@ main = do args@Args{..} <- getNodeOptions =<< getHomeDirectory let sev = if debug then Debug else Info- setupLogging Nothing $ productionB <> termSeveritiesOutB (severityPlus sev)+ initLogging sev config <- readConfig configPath runWorkM (WorkConfig config commonArgs) $ do logDebug $ "Just started with options: " <> show args
test/GlobalSpec.hs view
@@ -2,26 +2,23 @@ module GlobalSpec (spec) where -import Control.Lens (to)-import Data.Colour.SRGB (sRGB24show)-import qualified Data.Text as T-import Data.Text.Arbitrary ()-import Data.Time (LocalTime (..), TimeOfDay (..), getZonedTime,- zonedTimeToLocalTime)-import Data.Time.Calendar (addGregorianMonthsClip, fromGregorian)-import Test.Hspec (Spec, describe, runIO)-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Arbitrary (arbitrary), Gen, NonNegative (..),- Positive (..), Small (..), choose, forAll,- ioProperty, oneof, (.&&.), (===), (==>))-import Universum-import Unsafe (unsafeTail)+import Control.Lens (to)+import Data.Colour.SRGB (sRGB24show)+import qualified Data.List as L+import qualified Data.Text as T+import Data.Text.Arbitrary ()+import Data.Time (LocalTime (..), TimeOfDay (..), getZonedTime, zonedTimeToLocalTime)+import Data.Time.Calendar (addGregorianMonthsClip, fromGregorian)+import Test.Hspec (Spec, describe, runIO)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Arbitrary (arbitrary), Gen, NonNegative (..), Positive (..), Small (..),+ choose, forAll, ioProperty, oneof, (.&&.), (===), (==>))+import Universum -import OrgStat.Ast (Clock (..), Org (..), atDepth, mergeClocks,- orgClocks)-import OrgStat.Config (ConfDate (..), ConfRange (..))-import OrgStat.Helpers (convertRange)-import OrgStat.Util (addLocalTime, parseColour)+import OrgStat.Ast (Clock (..), Org (..), atDepth, mergeClocks, orgClocks)+import OrgStat.Config (ConfDate (..), ConfRange (..))+import OrgStat.Helpers (convertRange)+import OrgStat.Util (addLocalTime, parseColour) spec :: Spec@@ -71,7 +68,7 @@ contOrg dfrom dto = do (Positive i) <- arbitrary (checkpoints :: [LocalTime]) <- sort <$> replicateM (i+1) arbitrary- pairs <- forM (checkpoints `zip` unsafeTail checkpoints) $ \(c,c') -> do+ pairs <- forM (checkpoints `zip` L.tail checkpoints) $ \(c,c') -> do delta <- choose (dfrom,dto) pure (c, negate delta `addLocalTime` c') let clocks = map (uncurry Clock) pairs
test/Test.hs view
@@ -1,6 +1,6 @@-import Spec (spec)-import Test.Hspec (hspec)-import Universum+import Spec (spec)+import Test.Hspec (hspec)+import Universum main :: IO () main = hspec spec