mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-25 19:31:44 +03:00
dev: lib: Hledger.Utils cleanup
This commit is contained in:
parent
79047ccc43
commit
b079bbdb4e
@ -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
|
||||
|
@ -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 "<interactive>" 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
|
||||
|
@ -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:
|
||||
|
Loading…
Reference in New Issue
Block a user