{-# LANGUAGE CPP #-}
module Hledger.Utils (
applyN,
mapM',
sequence',
curry2,
uncurry2,
curry3,
uncurry3,
curry4,
uncurry4,
maximum',
maximumStrict,
minimumStrict,
splitAtElement,
sumStrict,
treeLeaves,
first3,
second3,
third3,
first4,
second4,
third4,
fourth4,
first5,
second5,
third5,
fourth5,
fifth5,
first6,
second6,
third6,
fourth6,
fifth6,
sixth6,
multicol,
numDigitsInt,
numDigitsInteger,
makeHledgerClassyLenses,
module Hledger.Utils.Debug,
module Hledger.Utils.Parse,
module Hledger.Utils.IO,
module Hledger.Utils.Regex,
module Hledger.Utils.String,
module Hledger.Utils.Text,
tests_Utils,
module Hledger.Utils.Test,
)
where
import Data.Char (toLower)
import Data.List (intersperse)
import Data.List.Extra (chunksOf, foldl1', uncons, unsnoc)
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
import qualified Data.Set as Set
import qualified Data.Text as T (pack, unpack)
import Data.Tree (foldTree, Tree (Node, subForest))
import Language.Haskell.TH (DecsQ, Name, mkName, nameBase)
import Lens.Micro ((&), (.~))
import Lens.Micro.TH (DefName(TopName), lensClass, lensField, makeLensesWith, classyRules)
import Hledger.Utils.Debug
import Hledger.Utils.Parse
import Hledger.Utils.IO
import Hledger.Utils.Regex
import Hledger.Utils.String
import Hledger.Utils.Text
import Hledger.Utils.Test
applyN :: Int -> (a -> a) -> a -> a
applyN :: forall a. Int -> (a -> a) -> a -> a
applyN Int
n a -> a
f | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = a -> a
forall a. a -> a
id
| Bool
otherwise = ([a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
n) ([a] -> a) -> (a -> [a]) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
f
{-# INLINABLE mapM' #-}
mapM' :: Monad f => (a -> f b) -> [a] -> f [b]
mapM' :: forall (f :: * -> *) a b. Monad f => (a -> f b) -> [a] -> f [b]
mapM' a -> f b
f = [f b] -> f [b]
forall (f :: * -> *) a. Monad f => [f a] -> f [a]
sequence' ([f b] -> f [b]) -> ([a] -> [f b]) -> [a] -> f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> [a] -> [f b]
forall a b. (a -> b) -> [a] -> [b]
map a -> f b
f
{-# INLINABLE sequence' #-}
sequence' :: Monad f => [f a] -> f [a]
sequence' :: forall (f :: * -> *) a. Monad f => [f a] -> f [a]
sequence' [f a]
ms = do
[a] -> [a]
h <- ([a] -> [a]) -> [f a] -> f ([a] -> [a])
forall {m :: * -> *} {a} {c}.
Monad m =>
([a] -> c) -> [m a] -> m ([a] -> c)
go [a] -> [a]
forall a. a -> a
id [f a]
ms
[a] -> f [a]
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
h [])
where
go :: ([a] -> c) -> [m a] -> m ([a] -> c)
go [a] -> c
h [] = ([a] -> c) -> m ([a] -> c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a] -> c
h
go [a] -> c
h (m a
m:[m a]
ms') = do
a
x <- m a
m
([a] -> c) -> [m a] -> m ([a] -> c)
go ([a] -> c
h ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [m a]
ms'
curry2 :: ((a, b) -> c) -> a -> b -> c
curry2 :: forall a b c. ((a, b) -> c) -> a -> b -> c
curry2 (a, b) -> c
f a
x b
y = (a, b) -> c
f (a
x, b
y)
uncurry2 :: (a -> b -> c) -> (a, b) -> c
uncurry2 :: forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry2 a -> b -> c
f (a
x, b
y) = a -> b -> c
f a
x b
y
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 :: forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (a, b, c) -> d
f a
x b
y c
z = (a, b, c) -> d
f (a
x, b
y, c
z)
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f (a
x, b
y, c
z) = a -> b -> c -> d
f a
x b
y c
z
curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 :: forall a b c d e. ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 (a, b, c, d) -> e
f a
w b
x c
y d
z = (a, b, c, d) -> e
f (a
w, b
x, c
y, d
z)
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 :: forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 a -> b -> c -> d -> e
f (a
w, b
x, c
y, d
z) = a -> b -> c -> d -> e
f a
w b
x c
y d
z
maximum' :: Integral a => [a] -> a
maximum' :: forall a. Integral a => [a] -> a
maximum' [] = a
0
maximum' [a]
xs = [a] -> a
forall a. Ord a => [a] -> a
maximumStrict [a]
xs
{-# INLINABLE maximumStrict #-}
maximumStrict :: Ord a => [a] -> a
maximumStrict :: forall a. Ord a => [a] -> a
maximumStrict = (a -> a -> a) -> [a] -> a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
max
{-# INLINABLE minimumStrict #-}
minimumStrict :: Ord a => [a] -> a
minimumStrict :: forall a. Ord a => [a] -> a
minimumStrict = (a -> a -> a) -> [a] -> a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
min
splitAtElement :: Eq a => a -> [a] -> [[a]]
splitAtElement :: forall a. Eq a => a -> [a] -> [[a]]
splitAtElement a
x [a]
l =
case [a]
l of
[] -> []
a
e:[a]
es | a
ea -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x -> [a] -> [[a]]
split [a]
es
[a]
es -> [a] -> [[a]]
split [a]
es
where
split :: [a] -> [[a]]
split [a]
es = let ([a]
first,[a]
rest) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
es
in [a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
splitAtElement a
x [a]
rest
{-# INLINABLE sumStrict #-}
sumStrict :: Num a => [a] -> a
sumStrict :: forall a. Num a => [a] -> a
sumStrict = (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
treeLeaves :: Tree a -> [a]
treeLeaves :: forall a. Tree a -> [a]
treeLeaves Node{subForest :: forall a. Tree a -> [Tree a]
subForest=[]} = []
treeLeaves Tree a
t = (a -> [[a]] -> [a]) -> Tree a -> [a]
forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree (\a
a [[a]]
bs -> (if [[a]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
bs then (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) else [a] -> [a]
forall a. a -> a
id) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
bs) Tree a
t
first3 :: (a, b, c) -> a
first3 (a
x,b
_,c
_) = a
x
second3 :: (a, b, c) -> b
second3 (a
_,b
x,c
_) = b
x
third3 :: (a, b, c) -> c
third3 (a
_,b
_,c
x) = c
x
first4 :: (a, b, c, d) -> a
first4 (a
x,b
_,c
_,d
_) = a
x
second4 :: (a, b, c, d) -> b
second4 (a
_,b
x,c
_,d
_) = b
x
third4 :: (a, b, c, d) -> c
third4 (a
_,b
_,c
x,d
_) = c
x
fourth4 :: (a, b, c, d) -> d
fourth4 (a
_,b
_,c
_,d
x) = d
x
first5 :: (a, b, c, d, e) -> a
first5 (a
x,b
_,c
_,d
_,e
_) = a
x
second5 :: (a, b, c, d, e) -> b
second5 (a
_,b
x,c
_,d
_,e
_) = b
x
third5 :: (a, b, c, d, e) -> c
third5 (a
_,b
_,c
x,d
_,e
_) = c
x
fourth5 :: (a, b, c, d, e) -> d
fourth5 (a
_,b
_,c
_,d
x,e
_) = d
x
fifth5 :: (a, b, c, d, e) -> e
fifth5 (a
_,b
_,c
_,d
_,e
x) = e
x
first6 :: (a, b, c, d, e, f) -> a
first6 (a
x,b
_,c
_,d
_,e
_,f
_) = a
x
second6 :: (a, b, c, d, e, f) -> b
second6 (a
_,b
x,c
_,d
_,e
_,f
_) = b
x
third6 :: (a, b, c, d, e, f) -> c
third6 (a
_,b
_,c
x,d
_,e
_,f
_) = c
x
fourth6 :: (a, b, c, d, e, f) -> d
fourth6 (a
_,b
_,c
_,d
x,e
_,f
_) = d
x
fifth6 :: (a, b, c, d, e, f) -> e
fifth6 (a
_,b
_,c
_,d
_,e
x,f
_) = e
x
sixth6 :: (a, b, c, d, e, f) -> f
sixth6 (a
_,b
_,c
_,d
_,e
_,f
x) = f
x
multicol :: Int -> [String] -> String
multicol :: Int -> [String] -> String
multicol Int
_ [] = []
multicol Int
width [String]
strs =
let
maxwidth :: Int
maxwidth = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
strs
numcols :: Int
numcols = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
strs) (Int
width Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
maxwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2))
itemspercol :: Int
itemspercol = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
strs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numcols
colitems :: [[String]]
colitems = Int -> [String] -> [[String]]
forall a. HasCallStack => Int -> [a] -> [[a]]
chunksOf Int
itemspercol [String]
strs
cols :: [String]
cols = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines [[String]]
colitems
sep :: String
sep = String
" "
in
Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
textConcatBottomPadded ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
sep [String]
cols
{-# INLINE numDigitsInt #-}
numDigitsInt :: Integral a => Int -> a
numDigitsInt :: forall a. Integral a => Int -> a
numDigitsInt Int
n
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = a
19
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> a
forall {a} {a}. (Num a, Integral a) => a -> a
go (Int -> Int
forall a. Num a => a -> a
negate Int
n)
| Bool
otherwise = Int -> a
forall {a} {a}. (Num a, Integral a) => a -> a
go Int
n
where
go :: a -> a
go a
a | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 = a
1
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
100 = a
2
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000 = a
3
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10000 = a
4
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10000000000000000 = a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
go (a
a a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
10000000000000000)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
100000000 = a
8 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
go (a
a a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
100000000)
| Bool
otherwise = a
4 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
go (a
a a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
10000)
numDigitsInteger :: Integer -> Int
numDigitsInteger :: Integer -> Int
numDigitsInteger = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (Integer -> String) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
makeHledgerClassyLenses :: Name -> DecsQ
makeHledgerClassyLenses :: Name -> DecsQ
makeHledgerClassyLenses Name
x = (LensRules -> Name -> DecsQ) -> Name -> LensRules -> DecsQ
forall a b c. (a -> b -> c) -> b -> a -> c
flip LensRules -> Name -> DecsQ
makeLensesWith Name
x (LensRules -> DecsQ) -> LensRules -> DecsQ
forall a b. (a -> b) -> a -> b
$ LensRules
classyRules
LensRules -> (LensRules -> LensRules) -> LensRules
forall a b. a -> (a -> b) -> b
& ((Name -> [Name] -> Name -> [DefName])
-> Identity (Name -> [Name] -> Name -> [DefName]))
-> LensRules -> Identity LensRules
Lens' LensRules (Name -> [Name] -> Name -> [DefName])
lensField (((Name -> [Name] -> Name -> [DefName])
-> Identity (Name -> [Name] -> Name -> [DefName]))
-> LensRules -> Identity LensRules)
-> (Name -> [Name] -> Name -> [DefName]) -> LensRules -> LensRules
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (\Name
_ [Name]
_ Name
n -> String -> [DefName]
fieldName (String -> [DefName]) -> String -> [DefName]
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
n)
LensRules -> (LensRules -> LensRules) -> LensRules
forall a b. a -> (a -> b) -> b
& ((Name -> Maybe (Name, Name))
-> Identity (Name -> Maybe (Name, Name)))
-> LensRules -> Identity LensRules
Lens' LensRules (Name -> Maybe (Name, Name))
lensClass (((Name -> Maybe (Name, Name))
-> Identity (Name -> Maybe (Name, Name)))
-> LensRules -> Identity LensRules)
-> (Name -> Maybe (Name, Name)) -> LensRules -> LensRules
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String -> Maybe (Name, Name)
className (String -> Maybe (Name, Name))
-> (Name -> String) -> Name -> Maybe (Name, Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase)
where
fieldName :: String -> [DefName]
fieldName String
n | Just (Char
'_', String
name) <- String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
uncons String
n = [Name -> DefName
TopName (String -> Name
mkName String
name)]
| Just (String
name, Char
'_') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
unsnoc String
n,
String
name String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
queryFields = [Name -> DefName
TopName (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"NoUpdate")]
| Just (String
name, Char
'_') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
unsnoc String
n,
String
name String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
commonFields = [Name -> DefName
TopName (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__")]
| Just (String
name, Char
'_') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
unsnoc String
n = [Name -> DefName
TopName (String -> Name
mkName String
name)]
| Bool
otherwise = []
commonFields :: Set String
commonFields = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList
[ String
"empty", String
"drop", String
"color", String
"transpose"
, String
"anon", String
"new", String
"auto"
, String
"rawopts", String
"file", String
"debug", String
"width"
]
className :: String -> Maybe (Name, Name)
className String
"ReportOpts" = (Name, Name) -> Maybe (Name, Name)
forall a. a -> Maybe a
Just (String -> Name
mkName String
"HasReportOptsNoUpdate", String -> Name
mkName String
"reportOptsNoUpdate")
className (Char
x':String
xs) = (Name, Name) -> Maybe (Name, Name)
forall a. a -> Maybe a
Just (String -> Name
mkName (String
"Has" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
x'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs), String -> Name
mkName (Char -> Char
toLower Char
x' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs))
className [] = Maybe (Name, Name)
forall a. Maybe a
Nothing
queryFields :: Set String
queryFields = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"period", String
"statuses", String
"depth", String
"date2", String
"real", String
"querystring"]
tests_Utils :: TestTree
tests_Utils = String -> [TestTree] -> TestTree
testGroup String
"Utils" [
TestTree
tests_Text
]