1{-| 2 3Standard imports and utilities which are useful everywhere, or needed low 4in the module hierarchy. This is the bottom of hledger's module graph. 5 6-} 7{-# LANGUAGE OverloadedStrings, LambdaCase #-} 8 9module Hledger.Utils (---- provide these frequently used modules - or not, for clearer api: 10 -- module Control.Monad, 11 -- module Data.List, 12 -- module Data.Maybe, 13 -- module Data.Time.Calendar, 14 -- module Data.Time.Clock, 15 -- module Data.Time.LocalTime, 16 -- module Data.Tree, 17 -- module Text.RegexPR, 18 -- module Text.Printf, 19 ---- all of this one: 20 module Hledger.Utils, 21 module Hledger.Utils.Debug, 22 module Hledger.Utils.Parse, 23 module Hledger.Utils.Regex, 24 module Hledger.Utils.String, 25 module Hledger.Utils.Text, 26 module Hledger.Utils.Test, 27 module Hledger.Utils.Color, 28 module Hledger.Utils.Tree, 29 -- Debug.Trace.trace, 30 -- module Data.PPrint, 31 -- module Hledger.Utils.UTF8IOCompat 32 error',userError',usageError, 33 -- the rest need to be done in each module I think 34 ) 35where 36 37import Control.Monad (liftM, when) 38-- import Data.Char 39import Data.Default 40import Data.FileEmbed (makeRelativeToProject, embedStringFile) 41import Data.List 42-- import Data.Maybe 43-- import Data.PPrint 44-- import Data.String.Here (hereFile) 45import Data.Text (Text) 46import qualified Data.Text.IO as T 47import Data.Time.Clock 48import Data.Time.LocalTime 49-- import Data.Text (Text) 50-- import qualified Data.Text as T 51-- import Language.Haskell.TH.Quote (QuasiQuoter(..)) 52import Language.Haskell.TH.Syntax (Q, Exp) 53import System.Directory (getHomeDirectory) 54import System.FilePath((</>), isRelative) 55import System.IO 56-- import Text.Printf 57-- import qualified Data.Map as Map 58 59import Hledger.Utils.Debug 60import Hledger.Utils.Parse 61import Hledger.Utils.Regex 62import Hledger.Utils.String 63import Hledger.Utils.Text 64import Hledger.Utils.Test 65import Hledger.Utils.Color 66import Hledger.Utils.Tree 67-- import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn) 68-- import Hledger.Utils.UTF8IOCompat (readFile,writeFile,appendFile,getContents,putStr,putStrLn) 69import Hledger.Utils.UTF8IOCompat (error',userError',usageError) 70 71 72-- tuples 73 74first3 (x,_,_) = x 75second3 (_,x,_) = x 76third3 (_,_,x) = x 77 78first4 (x,_,_,_) = x 79second4 (_,x,_,_) = x 80third4 (_,_,x,_) = x 81fourth4 (_,_,_,x) = x 82 83first5 (x,_,_,_,_) = x 84second5 (_,x,_,_,_) = x 85third5 (_,_,x,_,_) = x 86fourth5 (_,_,_,x,_) = x 87fifth5 (_,_,_,_,x) = x 88 89first6 (x,_,_,_,_,_) = x 90second6 (_,x,_,_,_,_) = x 91third6 (_,_,x,_,_,_) = x 92fourth6 (_,_,_,x,_,_) = x 93fifth6 (_,_,_,_,x,_) = x 94sixth6 (_,_,_,_,_,x) = x 95 96-- currying 97 98 99curry2 :: ((a, b) -> c) -> a -> b -> c 100curry2 f x y = f (x, y) 101 102uncurry2 :: (a -> b -> c) -> (a, b) -> c 103uncurry2 f (x, y) = f x y 104 105curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d 106curry3 f x y z = f (x, y, z) 107 108uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d 109uncurry3 f (x, y, z) = f x y z 110 111curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e 112curry4 f w x y z = f (w, x, y, z) 113 114uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e 115uncurry4 f (w, x, y, z) = f w x y z 116 117-- lists 118 119splitAtElement :: Eq a => a -> [a] -> [[a]] 120splitAtElement x l = 121 case l of 122 [] -> [] 123 e:es | e==x -> split es 124 es -> split es 125 where 126 split es = let (first,rest) = break (x==) es 127 in first : splitAtElement x rest 128 129-- text 130 131-- time 132 133getCurrentLocalTime :: IO LocalTime 134getCurrentLocalTime = do 135 t <- getCurrentTime 136 tz <- getCurrentTimeZone 137 return $ utcToLocalTime tz t 138 139getCurrentZonedTime :: IO ZonedTime 140getCurrentZonedTime = do 141 t <- getCurrentTime 142 tz <- getCurrentTimeZone 143 return $ utcToZonedTime tz t 144 145-- misc 146 147instance Default Bool where def = False 148 149-- | Apply a function the specified number of times, 150-- which should be > 0 (otherwise does nothing). 151-- Possibly uses O(n) stack ? 152applyN :: Int -> (a -> a) -> a -> a 153applyN n f | n < 1 = id 154 | otherwise = (!! n) . iterate f 155-- from protolude, compare 156-- applyN :: Int -> (a -> a) -> a -> a 157-- applyN n f = X.foldr (.) identity (X.replicate n f) 158 159-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one, 160-- given the current directory. ~username is not supported. Leave "-" unchanged. 161-- Can raise an error. 162expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in reader parsers 163expandPath _ "-" = return "-" 164expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandHomePath p 165-- PARTIAL: 166 167-- | Expand user home path indicated by tilde prefix 168expandHomePath :: FilePath -> IO FilePath 169expandHomePath = \case 170 ('~':'/':p) -> (</> p) <$> getHomeDirectory 171 ('~':'\\':p) -> (</> p) <$> getHomeDirectory 172 ('~':_) -> ioError $ userError "~USERNAME in paths is not supported" 173 p -> return p 174 175-- | Read text from a file, 176-- converting any \r\n line endings to \n,, 177-- using the system locale's text encoding, 178-- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8. 179readFilePortably :: FilePath -> IO Text 180readFilePortably f = openFile f ReadMode >>= readHandlePortably 181 182-- | Like readFilePortably, but read from standard input if the path is "-". 183readFileOrStdinPortably :: String -> IO Text 184readFileOrStdinPortably f = openFileOrStdin f ReadMode >>= readHandlePortably 185 where 186 openFileOrStdin :: String -> IOMode -> IO Handle 187 openFileOrStdin "-" _ = return stdin 188 openFileOrStdin f m = openFile f m 189 190readHandlePortably :: Handle -> IO Text 191readHandlePortably h = do 192 hSetNewlineMode h universalNewlineMode 193 menc <- hGetEncoding h 194 when (fmap show menc == Just "UTF-8") $ -- XXX no Eq instance, rely on Show 195 hSetEncoding h utf8_bom 196 T.hGetContents h 197 198-- | Total version of maximum, for integral types, giving 0 for an empty list. 199maximum' :: Integral a => [a] -> a 200maximum' [] = 0 201maximum' xs = maximumStrict xs 202 203-- | Strict version of sum that doesn’t leak space 204{-# INLINABLE sumStrict #-} 205sumStrict :: Num a => [a] -> a 206sumStrict = foldl' (+) 0 207 208-- | Strict version of maximum that doesn’t leak space 209{-# INLINABLE maximumStrict #-} 210maximumStrict :: Ord a => [a] -> a 211maximumStrict = foldl1' max 212 213-- | Strict version of minimum that doesn’t leak space 214{-# INLINABLE minimumStrict #-} 215minimumStrict :: Ord a => [a] -> a 216minimumStrict = foldl1' min 217 218-- | This is a version of sequence based on difference lists. It is 219-- slightly faster but we mostly use it because it uses the heap 220-- instead of the stack. This has the advantage that Neil Mitchell’s 221-- trick of limiting the stack size to discover space leaks doesn’t 222-- show this as a false positive. 223{-# INLINABLE sequence' #-} 224sequence' :: Monad f => [f a] -> f [a] 225sequence' ms = do 226 h <- go id ms 227 return (h []) 228 where 229 go h [] = return h 230 go h (m:ms) = do 231 x <- m 232 go (h . (x :)) ms 233 234-- | Like mapM but uses sequence'. 235{-# INLINABLE mapM' #-} 236mapM' :: Monad f => (a -> f b) -> [a] -> f [b] 237mapM' f = sequence' . map f 238 239-- | Like embedFile, but takes a path relative to the package directory. 240-- Similar to embedFileRelative ? 241embedFileRelative :: FilePath -> Q Exp 242embedFileRelative f = makeRelativeToProject f >>= embedStringFile 243 244-- -- | Like hereFile, but takes a path relative to the package directory. 245-- -- Similar to embedFileRelative ? 246-- hereFileRelative :: FilePath -> Q Exp 247-- hereFileRelative f = makeRelativeToProject f >>= hereFileExp 248-- where 249-- QuasiQuoter{quoteExp=hereFileExp} = hereFile 250 251tests_Utils = tests "Utils" [ 252 tests_Text 253 ] 254