{-# LANGUAGE OverloadedStrings, LambdaCase #-}
module Hledger.Utils (
module Hledger.Utils,
module Hledger.Utils.Debug,
module Hledger.Utils.Parse,
module Hledger.Utils.Regex,
module Hledger.Utils.String,
module Hledger.Utils.Text,
module Hledger.Utils.Test,
module Hledger.Utils.Color,
module Hledger.Utils.Tree,
error',userError',usageError,
)
where
import Control.Monad (liftM, when)
import Data.Default
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
import Data.List
import Data.Text (Text)
import qualified Data.Text.IO as T
import Data.Time.Clock
import Data.Time.LocalTime
import Language.Haskell.TH.Syntax (Q, Exp)
import System.Directory (getHomeDirectory)
import System.FilePath((</>), isRelative)
import System.IO
import Hledger.Utils.Debug
import Hledger.Utils.Parse
import Hledger.Utils.Regex
import Hledger.Utils.String
import Hledger.Utils.Text
import Hledger.Utils.Test
import Hledger.Utils.Color
import Hledger.Utils.Tree
import Hledger.Utils.UTF8IOCompat (error',userError',usageError)
first3 :: (a, b, c) -> a
first3 (x :: a
x,_,_) = a
x
second3 :: (a, b, c) -> b
second3 (_,x :: b
x,_) = b
x
third3 :: (a, b, c) -> c
third3 (_,_,x :: c
x) = c
x
first4 :: (a, b, c, d) -> a
first4 (x :: a
x,_,_,_) = a
x
second4 :: (a, b, c, d) -> b
second4 (_,x :: b
x,_,_) = b
x
third4 :: (a, b, c, d) -> c
third4 (_,_,x :: c
x,_) = c
x
fourth4 :: (a, b, c, d) -> d
fourth4 (_,_,_,x :: d
x) = d
x
first5 :: (a, b, c, d, e) -> a
first5 (x :: a
x,_,_,_,_) = a
x
second5 :: (a, b, c, d, e) -> b
second5 (_,x :: b
x,_,_,_) = b
x
third5 :: (a, b, c, d, e) -> c
third5 (_,_,x :: c
x,_,_) = c
x
fourth5 :: (a, b, c, d, e) -> d
fourth5 (_,_,_,x :: d
x,_) = d
x
fifth5 :: (a, b, c, d, e) -> e
fifth5 (_,_,_,_,x :: e
x) = e
x
first6 :: (a, b, c, d, e, f) -> a
first6 (x :: a
x,_,_,_,_,_) = a
x
second6 :: (a, b, c, d, e, f) -> b
second6 (_,x :: b
x,_,_,_,_) = b
x
third6 :: (a, b, c, d, e, f) -> c
third6 (_,_,x :: c
x,_,_,_) = c
x
fourth6 :: (a, b, c, d, e, f) -> d
fourth6 (_,_,_,x :: d
x,_,_) = d
x
fifth6 :: (a, b, c, d, e, f) -> e
fifth6 (_,_,_,_,x :: e
x,_) = e
x
sixth6 :: (a, b, c, d, e, f) -> f
sixth6 (_,_,_,_,_,x :: f
x) = f
x
curry2 :: ((a, b) -> c) -> a -> b -> c
curry2 :: ((a, b) -> c) -> a -> b -> c
curry2 f :: (a, b) -> c
f x :: a
x y :: b
y = (a, b) -> c
f (a
x, b
y)
uncurry2 :: (a -> b -> c) -> (a, b) -> c
uncurry2 :: (a -> b -> c) -> (a, b) -> c
uncurry2 f :: a -> b -> c
f (x :: a
x, y :: b
y) = a -> b -> c
f a
x b
y
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 f :: (a, b, c) -> d
f x :: a
x y :: b
y z :: c
z = (a, b, c) -> d
f (a
x, b
y, c
z)
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f :: a -> b -> c -> d
f (x :: a
x, y :: b
y, z :: 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 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 f :: (a, b, c, d) -> e
f w :: a
w x :: b
x y :: c
y z :: 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 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 f :: a -> b -> c -> d -> e
f (w :: a
w, x :: b
x, y :: c
y, z :: d
z) = a -> b -> c -> d -> e
f a
w b
x c
y d
z
splitAtElement :: Eq a => a -> [a] -> [[a]]
splitAtElement :: a -> [a] -> [[a]]
splitAtElement x :: a
x l :: [a]
l =
case [a]
l of
[] -> []
e :: a
e:es :: [a]
es | a
ea -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x -> [a] -> [[a]]
split [a]
es
es :: [a]
es -> [a] -> [[a]]
split [a]
es
where
split :: [a] -> [[a]]
split es :: [a]
es = let (first :: [a]
first,rest :: [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
getCurrentLocalTime :: IO LocalTime
getCurrentLocalTime :: IO LocalTime
getCurrentLocalTime = do
UTCTime
t <- IO UTCTime
getCurrentTime
TimeZone
tz <- IO TimeZone
getCurrentTimeZone
LocalTime -> IO LocalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> IO LocalTime) -> LocalTime -> IO LocalTime
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
t
getCurrentZonedTime :: IO ZonedTime
getCurrentZonedTime :: IO ZonedTime
getCurrentZonedTime = do
UTCTime
t <- IO UTCTime
getCurrentTime
TimeZone
tz <- IO TimeZone
getCurrentTimeZone
ZonedTime -> IO ZonedTime
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonedTime -> IO ZonedTime) -> ZonedTime -> IO ZonedTime
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz UTCTime
t
instance Default Bool where def :: Bool
def = Bool
False
applyN :: Int -> (a -> a) -> a -> a
applyN :: Int -> (a -> a) -> a -> a
applyN n :: Int
n f :: a -> a
f | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = a -> a
forall a. a -> a
id
| Bool
otherwise = ([a] -> Int -> a
forall a. [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
expandPath :: FilePath -> FilePath -> IO FilePath
expandPath :: FilePath -> FilePath -> IO FilePath
expandPath _ "-" = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return "-"
expandPath curdir :: FilePath
curdir p :: FilePath
p = (if FilePath -> Bool
isRelative FilePath
p then (FilePath
curdir FilePath -> FilePath -> FilePath
</>) else FilePath -> FilePath
forall a. a -> a
id) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FilePath -> IO FilePath
expandHomePath FilePath
p
expandHomePath :: FilePath -> IO FilePath
expandHomePath :: FilePath -> IO FilePath
expandHomePath = \case
('~':'/':p :: FilePath
p) -> (FilePath -> FilePath -> FilePath
</> FilePath
p) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getHomeDirectory
('~':'\\':p :: FilePath
p) -> (FilePath -> FilePath -> FilePath
</> FilePath
p) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getHomeDirectory
('~':_) -> IOError -> IO FilePath
forall a. IOError -> IO a
ioError (IOError -> IO FilePath) -> IOError -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError "~USERNAME in paths is not supported"
p :: FilePath
p -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
p
readFilePortably :: FilePath -> IO Text
readFilePortably :: FilePath -> IO Text
readFilePortably f :: FilePath
f = FilePath -> IOMode -> IO Handle
openFile FilePath
f IOMode
ReadMode IO Handle -> (Handle -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Text
readHandlePortably
readFileOrStdinPortably :: String -> IO Text
readFileOrStdinPortably :: FilePath -> IO Text
readFileOrStdinPortably f :: FilePath
f = FilePath -> IOMode -> IO Handle
openFileOrStdin FilePath
f IOMode
ReadMode IO Handle -> (Handle -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Text
readHandlePortably
where
openFileOrStdin :: String -> IOMode -> IO Handle
openFileOrStdin :: FilePath -> IOMode -> IO Handle
openFileOrStdin "-" _ = Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdin
openFileOrStdin f :: FilePath
f m :: IOMode
m = FilePath -> IOMode -> IO Handle
openFile FilePath
f IOMode
m
readHandlePortably :: Handle -> IO Text
readHandlePortably :: Handle -> IO Text
readHandlePortably h :: Handle
h = do
Handle -> NewlineMode -> IO ()
hSetNewlineMode Handle
h NewlineMode
universalNewlineMode
Maybe TextEncoding
menc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((TextEncoding -> FilePath) -> Maybe TextEncoding -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> FilePath
forall a. Show a => a -> FilePath
show Maybe TextEncoding
menc Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "UTF-8") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8_bom
Handle -> IO Text
T.hGetContents Handle
h
maximum' :: Integral a => [a] -> a
maximum' :: [a] -> a
maximum' [] = 0
maximum' xs :: [a]
xs = [a] -> a
forall a. Ord a => [a] -> a
maximumStrict [a]
xs
{-# INLINABLE sumStrict #-}
sumStrict :: Num a => [a] -> a
sumStrict :: [a] -> a
sumStrict = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) 0
{-# INLINABLE maximumStrict #-}
maximumStrict :: Ord a => [a] -> a
maximumStrict :: [a] -> a
maximumStrict = (a -> a -> a) -> [a] -> a
forall a. (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 :: [a] -> a
minimumStrict = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
min
{-# INLINABLE sequence' #-}
sequence' :: Monad f => [f a] -> f [a]
sequence' :: [f a] -> f [a]
sequence' ms :: [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 (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
h [])
where
go :: ([a] -> c) -> [m a] -> m ([a] -> c)
go h :: [a] -> c
h [] = ([a] -> c) -> m ([a] -> c)
forall (m :: * -> *) a. Monad m => a -> m a
return [a] -> c
h
go h :: [a] -> c
h (m :: m a
m:ms :: [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
{-# INLINABLE mapM' #-}
mapM' :: Monad f => (a -> f b) -> [a] -> f [b]
mapM' :: (a -> f b) -> [a] -> f [b]
mapM' f :: 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
embedFileRelative :: FilePath -> Q Exp
embedFileRelative :: FilePath -> Q Exp
embedFileRelative f :: FilePath
f = FilePath -> Q FilePath
makeRelativeToProject FilePath
f Q FilePath -> (FilePath -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Q Exp
embedStringFile
tests_Utils :: TestTree
tests_Utils = FilePath -> [TestTree] -> TestTree
tests "Utils" [
TestTree
tests_Text
]