{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Cli.Utils
(
unsupportedOutputFormatError,
withJournalDo,
writeOutput,
writeOutputLazyText,
journalTransform,
journalReload,
journalReloadIfChanged,
journalFileIsNewer,
openBrowserOn,
writeFileWithBackup,
writeFileWithBackupIfChanged,
readFileStrictly,
pivotByOpts,
anonymiseByOpts,
journalSimilarTransaction,
tests_Cli_Utils,
)
where
import Control.Exception as C
import Data.List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import Data.Time (Day)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Safe (readMay, headMay)
import System.Console.CmdArgs
import System.Directory (getModificationTime, getDirectoryContents, copyFile, doesFileExist)
import System.Exit
import System.FilePath ((</>), splitFileName, takeDirectory)
import System.Info (os)
import System.Process (readProcessWithExitCode)
import Text.Printf
import Text.Regex.TDFA ((=~))
import Hledger.Cli.CliOptions
import Hledger.Cli.Anon
import Hledger.Data
import Hledger.Read
import Hledger.Reports
import Hledger.Utils
import Control.Monad (when)
unsupportedOutputFormatError :: String -> String
unsupportedOutputFormatError :: [Char] -> [Char]
unsupportedOutputFormatError [Char]
fmt = [Char]
"Sorry, output format \""[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
fmt[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\" is unrecognised or not yet supported for this kind of report."
withJournalDo :: CliOpts -> (Journal -> IO a) -> IO a
withJournalDo :: forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts Journal -> IO a
cmd = do
[[Char]]
journalpaths <- CliOpts -> IO [[Char]]
journalFilePathFromOpts CliOpts
opts
Either [Char] Journal
files <- InputOpts -> [[Char]] -> IO (Either [Char] Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [[Char]]
journalpaths
let transformed :: Either [Char] Journal
transformed = CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> Either [Char] Journal -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Journal
files
([Char] -> IO a)
-> (Journal -> IO a) -> Either [Char] Journal -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO a
forall a. [Char] -> a
error' Journal -> IO a
cmd Either [Char] Journal
transformed
journalTransform :: CliOpts -> Journal -> Journal
journalTransform :: CliOpts -> Journal -> Journal
journalTransform CliOpts
opts =
CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts
(Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts =
case [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"pivot" (RawOpts -> Maybe [Char])
-> (CliOpts -> RawOpts) -> CliOpts -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> RawOpts
rawopts_ (CliOpts -> Maybe [Char]) -> CliOpts -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ CliOpts
opts of
Just [Char]
tag -> Text -> Journal -> Journal
journalPivot (Text -> Journal -> Journal) -> Text -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
tag
Maybe [Char]
Nothing -> Journal -> Journal
forall a. a -> a
id
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts =
if InputOpts -> Bool
anon_ (InputOpts -> Bool) -> (CliOpts -> InputOpts) -> CliOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> InputOpts
inputopts_ (CliOpts -> Bool) -> CliOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts
opts
then Journal -> Journal
forall a. Anon a => a -> a
anon
else Journal -> Journal
forall a. a -> a
id
writeOutput :: CliOpts -> String -> IO ()
writeOutput :: CliOpts -> [Char] -> IO ()
writeOutput CliOpts
opts [Char]
s = do
Maybe [Char]
f <- CliOpts -> IO (Maybe [Char])
outputFileFromOpts CliOpts
opts
(([Char] -> IO ())
-> ([Char] -> [Char] -> IO ()) -> Maybe [Char] -> [Char] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char] -> IO ()
putStr [Char] -> [Char] -> IO ()
writeFile Maybe [Char]
f) [Char]
s
writeOutputLazyText :: CliOpts -> TL.Text -> IO ()
writeOutputLazyText :: CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts Text
s = do
Maybe [Char]
f <- CliOpts -> IO (Maybe [Char])
outputFileFromOpts CliOpts
opts
((Text -> IO ())
-> ([Char] -> Text -> IO ()) -> Maybe [Char] -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
TL.putStr [Char] -> Text -> IO ()
TL.writeFile Maybe [Char]
f) Text
s
journalReloadIfChanged :: CliOpts -> Day -> Journal -> IO (Either String Journal, Bool)
journalReloadIfChanged :: CliOpts -> Day -> Journal -> IO (Either [Char] Journal, Bool)
journalReloadIfChanged CliOpts
opts Day
_d Journal
j = do
let maybeChangedFilename :: [Char] -> IO (Maybe [Char])
maybeChangedFilename [Char]
f = do Bool
newer <- Journal -> [Char] -> IO Bool
journalFileIsNewer Journal
j [Char]
f
Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
newer then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f else Maybe [Char]
forall a. Maybe a
Nothing
[[Char]]
changedfiles <- [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([Char] -> IO (Maybe [Char])) -> [[Char]] -> IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (Maybe [Char])
maybeChangedFilename (Journal -> [[Char]]
journalFilePaths Journal
j)
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
changedfiles
then do
Bool
verbose <- IO Bool
isLoud
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
verbose Bool -> Bool -> Bool
|| Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s has changed, reloading\n" ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
changedfiles)
Either [Char] Journal
ej <- CliOpts -> IO (Either [Char] Journal)
journalReload CliOpts
opts
(Either [Char] Journal, Bool) -> IO (Either [Char] Journal, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Journal
ej, Bool
True)
else
(Either [Char] Journal, Bool) -> IO (Either [Char] Journal, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> Either [Char] Journal
forall a b. b -> Either a b
Right Journal
j, Bool
False)
journalReload :: CliOpts -> IO (Either String Journal)
journalReload :: CliOpts -> IO (Either [Char] Journal)
journalReload CliOpts
opts = do
[[Char]]
journalpaths <- [Char] -> [[Char]] -> [[Char]]
forall a. Show a => [Char] -> a -> a
dbg6 [Char]
"reloading files" ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> IO [[Char]]
journalFilePathFromOpts CliOpts
opts
Either [Char] Journal
files <- InputOpts -> [[Char]] -> IO (Either [Char] Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [[Char]]
journalpaths
Either [Char] Journal -> IO (Either [Char] Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Journal -> IO (Either [Char] Journal))
-> Either [Char] Journal -> IO (Either [Char] Journal)
forall a b. (a -> b) -> a -> b
$ CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> Either [Char] Journal -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Journal
files
journalFileIsNewer :: Journal -> FilePath -> IO Bool
journalFileIsNewer :: Journal -> [Char] -> IO Bool
journalFileIsNewer Journal{jlastreadtime :: Journal -> POSIXTime
jlastreadtime=POSIXTime
tread} [Char]
f = do
Maybe POSIXTime
mtmod <- [Char] -> IO (Maybe POSIXTime)
maybeFileModificationTime [Char]
f
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
case Maybe POSIXTime
mtmod of
Just POSIXTime
tmod -> POSIXTime
tmod POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
tread
Maybe POSIXTime
Nothing -> Bool
False
maybeFileModificationTime :: FilePath -> IO (Maybe POSIXTime)
maybeFileModificationTime :: [Char] -> IO (Maybe POSIXTime)
maybeFileModificationTime [Char]
f = do
Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
f
if Bool
exists
then do
UTCTime
utc <- [Char] -> IO UTCTime
getModificationTime [Char]
f
Maybe POSIXTime -> IO (Maybe POSIXTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe POSIXTime -> IO (Maybe POSIXTime))
-> (POSIXTime -> Maybe POSIXTime)
-> POSIXTime
-> IO (Maybe POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (POSIXTime -> IO (Maybe POSIXTime))
-> POSIXTime -> IO (Maybe POSIXTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc
else
Maybe POSIXTime -> IO (Maybe POSIXTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe POSIXTime
forall a. Maybe a
Nothing
openBrowserOn :: String -> IO ExitCode
openBrowserOn :: [Char] -> IO ExitCode
openBrowserOn [Char]
u = [[Char]] -> [Char] -> IO ExitCode
trybrowsers [[Char]]
browsers [Char]
u
where
trybrowsers :: [[Char]] -> [Char] -> IO ExitCode
trybrowsers ([Char]
b:[[Char]]
bs) [Char]
u = do
(ExitCode
e,[Char]
_,[Char]
_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
b [[Char]
u] [Char]
""
case ExitCode
e of
ExitCode
ExitSuccess -> ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
ExitFailure Int
_ -> [[Char]] -> [Char] -> IO ExitCode
trybrowsers [[Char]]
bs [Char]
u
trybrowsers [] [Char]
u = do
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Could not start a web browser (tried: %s)" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
browsers
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Please open your browser and visit %s" [Char]
u
ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
127
browsers :: [[Char]]
browsers | [Char]
os[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"darwin" = [[Char]
"open"]
| [Char]
os[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"mingw32" = [[Char]
"c:/Program Files/Mozilla Firefox/firefox.exe"]
| Bool
otherwise = [[Char]
"sensible-browser",[Char]
"gnome-www-browser",[Char]
"firefox"]
writeFileWithBackupIfChanged :: FilePath -> T.Text -> IO Bool
writeFileWithBackupIfChanged :: [Char] -> Text -> IO Bool
writeFileWithBackupIfChanged [Char]
f Text
t = do
Text
s <- [Char] -> IO Text
readFilePortably [Char]
f
if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else [Char] -> IO ()
backUpFile [Char]
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Text -> IO ()
T.writeFile [Char]
f Text
t IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
writeFileWithBackup :: FilePath -> String -> IO ()
writeFileWithBackup :: [Char] -> [Char] -> IO ()
writeFileWithBackup [Char]
f [Char]
t = [Char] -> IO ()
backUpFile [Char]
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> [Char] -> IO ()
writeFile [Char]
f [Char]
t
readFileStrictly :: FilePath -> IO T.Text
readFileStrictly :: [Char] -> IO Text
readFileStrictly [Char]
f = [Char] -> IO Text
readFilePortably [Char]
f IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
s -> Int -> IO Int
forall a. a -> IO a
C.evaluate (Text -> Int
T.length Text
s) IO Int -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
backUpFile :: FilePath -> IO ()
backUpFile :: [Char] -> IO ()
backUpFile [Char]
fp = do
[[Char]]
fs <- [Char] -> IO [[Char]]
safeGetDirectoryContents ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeDirectory ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
fp
let ([Char]
d,[Char]
f) = [Char] -> ([Char], [Char])
splitFileName [Char]
fp
versions :: [Int]
versions = ([Char] -> Maybe Int) -> [[Char]] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char]
f [Char] -> [Char] -> Maybe Int
`backupNumber`) [[Char]]
fs
next :: Int
next = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
versions) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
f' :: [Char]
f' = [Char] -> [Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s.%d" [Char]
f Int
next
[Char] -> [Char] -> IO ()
copyFile [Char]
fp ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f')
safeGetDirectoryContents :: FilePath -> IO [FilePath]
safeGetDirectoryContents :: [Char] -> IO [[Char]]
safeGetDirectoryContents [Char]
"" = [Char] -> IO [[Char]]
getDirectoryContents [Char]
"."
safeGetDirectoryContents [Char]
fp = [Char] -> IO [[Char]]
getDirectoryContents [Char]
fp
backupNumber :: FilePath -> FilePath -> Maybe Int
backupNumber :: [Char] -> [Char] -> Maybe Int
backupNumber [Char]
f [Char]
g = case [Char]
g [Char] -> [Char] -> ([Char], [Char], [Char], [[Char]])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ([Char]
"^" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\.([0-9]+)$") of
([Char]
_::FilePath, [Char]
_::FilePath, [Char]
_::FilePath, [[Char]
ext::FilePath]) -> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay [Char]
ext
([Char], [Char], [Char], [[Char]])
_ -> Maybe Int
forall a. Maybe a
Nothing
journalSimilarTransaction :: CliOpts -> Journal -> T.Text -> Maybe Transaction
journalSimilarTransaction :: CliOpts -> Journal -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
cliopts Journal
j Text
desc = Maybe Transaction
mbestmatch
where
mbestmatch :: Maybe Transaction
mbestmatch = (Double, Transaction) -> Transaction
forall a b. (a, b) -> b
snd ((Double, Transaction) -> Transaction)
-> Maybe (Double, Transaction) -> Maybe Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Transaction)] -> Maybe (Double, Transaction)
forall a. [a] -> Maybe a
headMay [(Double, Transaction)]
bestmatches
bestmatches :: [(Double, Transaction)]
bestmatches =
([(Double, Transaction)] -> [Char])
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a. Show a => (a -> [Char]) -> a -> a
dbg1With ([[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([(Double, Transaction)] -> [[Char]])
-> [(Double, Transaction)]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"similar transactions:"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:) ([[Char]] -> [[Char]])
-> ([(Double, Transaction)] -> [[Char]])
-> [(Double, Transaction)]
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Transaction) -> [Char])
-> [(Double, Transaction)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
score,Transaction{Integer
[Tag]
[Posting]
Maybe Day
(SourcePos, SourcePos)
Text
Status
Day
tindex :: Transaction -> Integer
tprecedingcomment :: Transaction -> Text
tsourcepos :: Transaction -> (SourcePos, SourcePos)
tdate :: Transaction -> Day
tdate2 :: Transaction -> Maybe Day
tstatus :: Transaction -> Status
tcode :: Transaction -> Text
tdescription :: Transaction -> Text
tcomment :: Transaction -> Text
ttags :: Transaction -> [Tag]
tpostings :: Transaction -> [Posting]
tpostings :: [Posting]
ttags :: [Tag]
tcomment :: Text
tdescription :: Text
tcode :: Text
tstatus :: Status
tdate2 :: Maybe Day
tdate :: Day
tsourcepos :: (SourcePos, SourcePos)
tprecedingcomment :: Text
tindex :: Integer
..}) -> [Char] -> Double -> [Char] -> Text -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%0.3f %s %s" Double
score (Day -> [Char]
forall a. Show a => a -> [Char]
show Day
tdate) Text
tdescription)) ([(Double, Transaction)] -> [(Double, Transaction)])
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
Journal -> Query -> Text -> Int -> [(Double, Transaction)]
journalTransactionsSimilarTo Journal
j Query
q Text
desc Int
10
q :: Query
q = ReportOpts -> Query
queryFromFlags (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> ReportOpts) -> ReportSpec -> ReportOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
cliopts
tests_Cli_Utils :: TestTree
tests_Cli_Utils = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Utils" [
]