diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 9f4a0f349..4165013f2 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -5,7 +5,10 @@ These are the bottom of hledger's module graph. module Hledger.Utils ( - -- * Currying + -- * Functions + applyN, + mapM', + sequence', curry2, uncurry2, curry3, @@ -14,7 +17,11 @@ module Hledger.Utils ( uncurry4, -- * Lists + maximum', + maximumStrict, + minimumStrict, splitAtElement, + sumStrict, -- * Trees treeLeaves, @@ -40,21 +47,9 @@ module Hledger.Utils ( sixth6, -- * Misc - applyN, - mapM', - maximum', - maximumStrict, - minimumStrict, numDigitsInt, - sequence', - sumStrict, - makeHledgerClassyLenses, - -- * Tests - tests_Utils, - module Hledger.Utils.Test, - -- * Other module Hledger.Utils.Debug, module Hledger.Utils.Parse, @@ -63,6 +58,10 @@ module Hledger.Utils ( module Hledger.Utils.String, module Hledger.Utils.Text, + -- * Tests + tests_Utils, + module Hledger.Utils.Test, + ) where @@ -83,7 +82,38 @@ import Hledger.Utils.Text import Hledger.Utils.Test --- Currying +-- Functions + +-- | Apply a function the specified number of times, +-- which should be > 0 (otherwise does nothing). +-- Possibly uses O(n) stack ? +applyN :: Int -> (a -> a) -> a -> a +applyN n f | n < 1 = id + | otherwise = (!! n) . iterate f +-- from protolude, compare +-- applyN :: Int -> (a -> a) -> a -> a +-- applyN n f = X.foldr (.) identity (X.replicate n f) + +-- | Like mapM but uses sequence'. +{-# INLINABLE mapM' #-} +mapM' :: Monad f => (a -> f b) -> [a] -> f [b] +mapM' f = sequence' . map f + +-- | This is a version of sequence based on difference lists. It is +-- slightly faster but we mostly use it because it uses the heap +-- instead of the stack. This has the advantage that Neil Mitchell’s +-- trick of limiting the stack size to discover space leaks doesn’t +-- show this as a false positive. +{-# INLINABLE sequence' #-} +sequence' :: Monad f => [f a] -> f [a] +sequence' ms = do + h <- go id ms + return (h []) + where + go h [] = return h + go h (m:ms') = do + x <- m + go (h . (x :)) ms' curry2 :: ((a, b) -> c) -> a -> b -> c curry2 f x y = f (x, y) @@ -105,6 +135,21 @@ uncurry4 f (w, x, y, z) = f w x y z -- Lists +-- | Total version of maximum, for integral types, giving 0 for an empty list. +maximum' :: Integral a => [a] -> a +maximum' [] = 0 +maximum' xs = maximumStrict xs + +-- | Strict version of maximum that doesn’t leak space +{-# INLINABLE maximumStrict #-} +maximumStrict :: Ord a => [a] -> a +maximumStrict = foldl1' max + +-- | Strict version of minimum that doesn’t leak space +{-# INLINABLE minimumStrict #-} +minimumStrict :: Ord a => [a] -> a +minimumStrict = foldl1' min + splitAtElement :: Eq a => a -> [a] -> [[a]] splitAtElement x l = case l of @@ -115,6 +160,11 @@ splitAtElement x l = split es = let (first,rest) = break (x==) es in first : splitAtElement x rest +-- | Strict version of sum that doesn’t leak space +{-# INLINABLE sumStrict #-} +sumStrict :: Num a => [a] -> a +sumStrict = foldl' (+) 0 + -- Trees -- | Get the leaves of this tree as a list. @@ -149,57 +199,6 @@ sixth6 (_,_,_,_,_,x) = x -- Misc --- | Apply a function the specified number of times, --- which should be > 0 (otherwise does nothing). --- Possibly uses O(n) stack ? -applyN :: Int -> (a -> a) -> a -> a -applyN n f | n < 1 = id - | otherwise = (!! n) . iterate f --- from protolude, compare --- applyN :: Int -> (a -> a) -> a -> a --- applyN n f = X.foldr (.) identity (X.replicate n f) - --- | Total version of maximum, for integral types, giving 0 for an empty list. -maximum' :: Integral a => [a] -> a -maximum' [] = 0 -maximum' xs = maximumStrict xs - --- | Strict version of sum that doesn’t leak space -{-# INLINABLE sumStrict #-} -sumStrict :: Num a => [a] -> a -sumStrict = foldl' (+) 0 - --- | Strict version of maximum that doesn’t leak space -{-# INLINABLE maximumStrict #-} -maximumStrict :: Ord a => [a] -> a -maximumStrict = foldl1' max - --- | Strict version of minimum that doesn’t leak space -{-# INLINABLE minimumStrict #-} -minimumStrict :: Ord a => [a] -> a -minimumStrict = foldl1' min - --- | This is a version of sequence based on difference lists. It is --- slightly faster but we mostly use it because it uses the heap --- instead of the stack. This has the advantage that Neil Mitchell’s --- trick of limiting the stack size to discover space leaks doesn’t --- show this as a false positive. -{-# INLINABLE sequence' #-} -sequence' :: Monad f => [f a] -> f [a] -sequence' ms = do - h <- go id ms - return (h []) - where - go h [] = return h - go h (m:ms') = do - x <- m - go (h . (x :)) ms' - --- | Like mapM but uses sequence'. -{-# INLINABLE mapM' #-} -mapM' :: Monad f => (a -> f b) -> [a] -> f [b] -mapM' f = sequence' . map f - -- | Find the number of digits of an 'Int'. {-# INLINE numDigitsInt #-} numDigitsInt :: Integral a => Int -> a diff --git a/hledger-lib/Hledger/Utils/Debug.hs b/hledger-lib/Hledger/Utils/Debug.hs index 926b708de..a9c7e1f13 100644 --- a/hledger-lib/Hledger/Utils/Debug.hs +++ b/hledger-lib/Hledger/Utils/Debug.hs @@ -23,8 +23,7 @@ where PROGNAME is the executable name returned by @getProgName@. If using the logging feature you should ensure a stable program name by setting it explicitly with @withProgName@ at the start of your program (since otherwise it will change to "" when you are testing in GHCI). -Eg: -@main = withProgName "MYPROG" $ do ...@. +Eg: @main = withProgName "MYPROG" $ do ...@. The "traceOrLog" and "dbg" functions normally print to stderr, but if the program name has been set to "MYPROG,logging" (ie, with a ",logging" suffix), they will log to @@ -41,6 +40,7 @@ If you are working in GHCI, changing the debug level requires editing and reload In hledger, debug levels are used as follows: +@ Debug level: What to show: ------------ --------------------------------------------------------- 0 normal command output only (no warnings, eg) @@ -53,6 +53,7 @@ Debug level: What to show: 7 input file reading, more detail 8 command line parsing 9 any other rarely needed / more in-depth info +@ -} @@ -164,13 +165,10 @@ progName = then reverse $ drop 8 $ reverse modifiedProgName else modifiedProgName --- | Global debug output level. This is the requested verbosity of --- debug output printed to stderr. The default is 0 meaning no debug output. +-- | The programs debug output verbosity. The default is 0 meaning no debug output. -- The @--debug@ command line flag sets it to 1, or @--debug=N@ sets it to --- a higher value (note: not @--debug N@ for some reason). This uses --- unsafePerformIO and can be accessed from anywhere and before normal --- command-line processing. When running with :main in GHCI, you must --- touch and reload this module to see the effect of a new --debug option. +-- a higher value (the = is required). Uses unsafePerformIO. +-- When running in GHCI, changing this requires reloading this module. debugLevel :: Int debugLevel = case dropWhile (/="--debug") progArgs of ["--debug"] -> 1 diff --git a/hledger-lib/Hledger/Utils/IO.hs b/hledger-lib/Hledger/Utils/IO.hs index 49527aa3a..63da0da7a 100644 --- a/hledger-lib/Hledger/Utils/IO.hs +++ b/hledger-lib/Hledger/Utils/IO.hs @@ -1,6 +1,6 @@ {- | -Helpers for pretty-formatting haskell values, pretty-printing to console, -deciding if ANSI colour should be used, and detecting an -o/--output-file option. +Helpers for pretty-printing haskell values, reading command line arguments, +working with ANSI colours, files, and time. Uses unsafePerformIO. Limitations: