module Hledger.Data.Utils (
module Data.Char,
module Control.Monad,
module Data.List,
module Data.Maybe,
module Data.Ord,
module Data.Tree,
module Data.Time.Clock,
module Data.Time.Calendar,
module Data.Time.LocalTime,
module Debug.Trace,
module Hledger.Data.Utils,
module Text.Printf,
module Text.RegexPR,
module Test.HUnit,
)
where
import Data.Char
import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded)
import Control.Monad
import Data.List
import Data.Maybe
import Data.Ord
import Data.Tree
import Data.Time.Clock
import Data.Time.Calendar
import Data.Time.LocalTime
import Debug.Trace
import Test.HUnit
import Text.Printf
import Text.RegexPR
import Text.ParserCombinators.Parsec
import System.Info (os)
lowercase = map toLower
uppercase = map toUpper
strip = lstrip . rstrip
lstrip = dropws
rstrip = reverse . dropws . reverse
dropws = dropWhile (`elem` " \t")
elideLeft width s =
if length s > width then ".." ++ reverse (take (width 2) $ reverse s) else s
elideRight width s =
if length s > width then take (width 2) s ++ ".." else s
underline :: String -> String
underline s = s' ++ replicate (length s) '-' ++ "\n"
where s'
| last s == '\n' = s
| otherwise = s ++ "\n"
unbracket :: String -> String
unbracket s
| (head s == '[' && last s == ']') || (head s == '(' && last s == ')') = init $ tail s
| otherwise = s
concatTopPadded :: [String] -> String
concatTopPadded strs = intercalate "\n" $ map concat $ transpose padded
where
lss = map lines strs
h = maximum $ map length lss
ypad ls = replicate (difforzero h (length ls)) "" ++ ls
xpad ls = map (padleft w) ls where w | null ls = 0
| otherwise = maximum $ map length ls
padded = map (xpad . ypad) lss
concatBottomPadded :: [String] -> String
concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded
where
lss = map lines strs
h = maximum $ map length lss
ypad ls = ls ++ replicate (difforzero h (length ls)) ""
xpad ls = map (padleft w) ls where w | null ls = 0
| otherwise = maximum $ map length ls
padded = map (xpad . ypad) lss
vConcatRightAligned :: [String] -> String
vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss
where
showfixedwidth = printf (printf "%%%ds" width)
width = maximum $ map length ss
padtop :: Int -> String -> String
padtop h s = intercalate "\n" xpadded
where
ls = lines s
sh = length ls
sw | null ls = 0
| otherwise = maximum $ map length ls
ypadded = replicate (difforzero h sh) "" ++ ls
xpadded = map (padleft sw) ypadded
padbottom :: Int -> String -> String
padbottom h s = intercalate "\n" xpadded
where
ls = lines s
sh = length ls
sw | null ls = 0
| otherwise = maximum $ map length ls
ypadded = ls ++ replicate (difforzero h sh) ""
xpadded = map (padleft sw) ypadded
padleft :: Int -> String -> String
padleft w "" = concat $ replicate w " "
padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s
padright :: Int -> String -> String
padright w "" = concat $ replicate w " "
padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s
cliptopleft :: Int -> Int -> String -> String
cliptopleft w h = intercalate "\n" . take h . map (take w) . lines
fitto :: Int -> Int -> String -> String
fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline
where
rows = map (fit w) $ lines s
fit w = take w . (++ repeat ' ')
blankline = replicate w ' '
type PlatformString = String
fromPlatformString :: PlatformString -> String
fromPlatformString s = if UTF8.isUTF8Encoded s then UTF8.decodeString s else s
toPlatformString :: String -> PlatformString
toPlatformString = case os of
"unix" -> UTF8.encodeString
"linux" -> UTF8.encodeString
"darwin" -> UTF8.encodeString
_ -> id
error' :: String -> a
error' = error . toPlatformString
userError' :: String -> IOError
userError' = userError . toPlatformString
difforzero :: (Num a, Ord a) => a -> a -> a
difforzero a b = maximum [(a b), 0]
containsRegex :: String -> String -> Bool
containsRegex r s = case matchRegexPR ("(?i)"++r) s of
Just _ -> True
_ -> False
splitAtElement :: Eq a => a -> [a] -> [[a]]
splitAtElement e l =
case dropWhile (e==) l of
[] -> []
l' -> first : splitAtElement e rest
where
(first,rest) = break (e==) l'
root = rootLabel
subs = subForest
branches = subForest
leaves :: Tree a -> [a]
leaves (Node v []) = [v]
leaves (Node _ branches) = concatMap leaves branches
subtreeat :: Eq a => a -> Tree a -> Maybe (Tree a)
subtreeat v t
| root t == v = Just t
| otherwise = subtreeinforest v $ subs t
subtreeinforest :: Eq a => a -> [Tree a] -> Maybe (Tree a)
subtreeinforest _ [] = Nothing
subtreeinforest v (t:ts) = case (subtreeat v t) of
Just t' -> Just t'
Nothing -> subtreeinforest v ts
treeprune :: Int -> Tree a -> Tree a
treeprune 0 t = Node (root t) []
treeprune d t = Node (root t) (map (treeprune $ d1) $ branches t)
treemap :: (a -> b) -> Tree a -> Tree b
treemap f t = Node (f $ root t) (map (treemap f) $ branches t)
treefilter :: (a -> Bool) -> Tree a -> Tree a
treefilter f t = Node
(root t)
(map (treefilter f) $ filter (treeany f) $ branches t)
treeany :: (a -> Bool) -> Tree a -> Bool
treeany f t = f (root t) || any (treeany f) (branches t)
showtree :: Show a => Tree a -> String
showtree = unlines . filter (containsRegex "[^ \\|]") . lines . drawTree . treemap show
showforest :: Show a => Forest a -> String
showforest = concatMap showtree
strace :: Show a => a -> a
strace a = trace (show a) a
ltrace :: Show a => String -> a -> a
ltrace l a = trace (l ++ ": " ++ show a) a
mtrace :: (Monad m, Show a) => a -> m a
mtrace a = strace a `seq` return a
tracewith f e = trace (f e) e
choice' :: [GenParser tok st a] -> GenParser tok st a
choice' = choice . map Text.ParserCombinators.Parsec.try
parsewith :: Parser a -> String -> Either ParseError a
parsewith p = parse p ""
parseWithCtx :: b -> GenParser Char b a -> String -> Either ParseError a
parseWithCtx ctx p = runParser p ctx ""
fromparse :: Either ParseError a -> a
fromparse = either parseerror id
parseerror e = error' $ showParseError e
showParseError e = "parse error at " ++ show e
showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e)
nonspace :: GenParser Char st Char
nonspace = satisfy (not . isSpace)
spacenonewline :: GenParser Char st Char
spacenonewline = satisfy (`elem` " \v\f\t")
restofline :: GenParser Char st String
restofline = anyChar `manyTill` newline
getCurrentLocalTime :: IO LocalTime
getCurrentLocalTime = do
t <- getCurrentTime
tz <- getCurrentTimeZone
return $ utcToLocalTime tz t
tname :: Test -> String
tname (TestLabel n _) = n
tname _ = ""
tflatten :: Test -> [Test]
tflatten (TestLabel _ t@(TestList _)) = tflatten t
tflatten (TestList ts) = concatMap tflatten ts
tflatten t = [t]
tfilter :: (Test -> Bool) -> Test -> Test
tfilter p (TestLabel l ts) = TestLabel l (tfilter p ts)
tfilter p (TestList ts) = TestList $ filter (any p . tflatten) $ map (tfilter p) ts
tfilter _ t = t
is :: (Eq a, Show a) => a -> a -> Assertion
a `is` e = assertEqual "" e a
assertParse :: (Either ParseError a) -> Assertion
assertParse parse = either (assertFailure.show) (const (return ())) parse
assertParseEqual :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
assertParseEqual parse expected = either (assertFailure.show) (`is` expected) parse
printParseError :: (Show a) => a -> IO ()
printParseError e = do putStr "parse error at "; print e
isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft _ = False
isRight :: Either a b -> Bool
isRight = not . isLeft
applyN :: Int -> (a -> a) -> a -> a
applyN n f = (!! n) . iterate f