{-# LANGUAGE CPP #-}{-|
Standard imports and utilities which are useful everywhere, or needed low
in the module hierarchy. This is the bottom of hledger's module graph.
-}moduleHledger.Data.Utils(moduleData.Char,moduleControl.Monad,moduleData.List,--module Data.Map,moduleData.Maybe,moduleData.Ord,moduleData.Tree,moduleData.Time.Clock,moduleData.Time.Calendar,moduleData.Time.LocalTime,moduleDebug.Trace,moduleHledger.Data.Utils,-- module Hledger.Data.UTF8,moduleText.Printf,moduleText.RegexPR,moduleTest.HUnit,)whereimportData.CharimportCodec.Binary.UTF8.StringasUTF8(decodeString,encodeString,isUTF8Encoded)importControl.MonadimportData.List--import qualified Data.Map as MapimportData.MaybeimportData.OrdimportData.TreeimportData.Time.ClockimportData.Time.CalendarimportData.Time.LocalTimeimportDebug.Trace-- needs to be done in each module I think-- import Prelude hiding (readFile,writeFile,getContents,putStr,putStrLn)-- import Hledger.Data.UTF8importTest.HUnitimportText.PrintfimportText.RegexPRimportText.ParserCombinators.ParsecimportSystem.Info(os)-- stringslowercase=maptoLoweruppercase=maptoUpperstrip=lstrip.rstriplstrip=dropwsrstrip=reverse.dropws.reversedropws=dropWhile(`elem`" \t")elideLeftwidths=iflengths>widththen".."++reverse(take(width-2)$reverses)elseselideRightwidths=iflengths>widththentake(width-2)s++".."elsesunderline::String->Stringunderlines=s'++replicate(lengths)'-'++"\n"wheres'|lasts=='\n'=s|otherwise=s++"\n"unbracket::String->Stringunbrackets|(heads=='['&&lasts==']')||(heads=='('&&lasts==')')=init$tails|otherwise=s-- | Join multi-line strings as side-by-side rectangular strings of the same height, top-padded.concatTopPadded::[String]->StringconcatTopPaddedstrs=intercalate"\n"$mapconcat$transposepaddedwherelss=maplinesstrsh=maximum$maplengthlssypadls=replicate(difforzeroh(lengthls))""++lsxpadls=map(padleftw)lswherew|nullls=0|otherwise=maximum$maplengthlspadded=map(xpad.ypad)lss-- | Join multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.concatBottomPadded::[String]->StringconcatBottomPaddedstrs=intercalate"\n"$mapconcat$transposepaddedwherelss=maplinesstrsh=maximum$maplengthlssypadls=ls++replicate(difforzeroh(lengthls))""xpadls=map(padleftw)lswherew|nullls=0|otherwise=maximum$maplengthlspadded=map(xpad.ypad)lss-- | Compose strings vertically and right-aligned.vConcatRightAligned::[String]->StringvConcatRightAlignedss=intercalate"\n"$mapshowfixedwidthsswhereshowfixedwidth=printf(printf"%%%ds"width)width=maximum$maplengthss-- | Convert a multi-line string to a rectangular string top-padded to the specified height.padtop::Int->String->Stringpadtophs=intercalate"\n"xpaddedwherels=linesssh=lengthlssw|nullls=0|otherwise=maximum$maplengthlsypadded=replicate(difforzerohsh)""++lsxpadded=map(padleftsw)ypadded-- | Convert a multi-line string to a rectangular string bottom-padded to the specified height.padbottom::Int->String->Stringpadbottomhs=intercalate"\n"xpaddedwherels=linesssh=lengthlssw|nullls=0|otherwise=maximum$maplengthlsypadded=ls++replicate(difforzerohsh)""xpadded=map(padleftsw)ypadded-- | Convert a multi-line string to a rectangular string left-padded to the specified width.padleft::Int->String->Stringpadleftw""=concat$replicatew" "padleftws=intercalate"\n"$map(printf(printf"%%%ds"w))$liness-- | Convert a multi-line string to a rectangular string right-padded to the specified width.padright::Int->String->Stringpadrightw""=concat$replicatew" "padrightws=intercalate"\n"$map(printf(printf"%%-%ds"w))$liness-- | Clip a multi-line string to the specified width and height from the top left.cliptopleft::Int->Int->String->Stringcliptopleftwh=intercalate"\n".takeh.map(takew).lines-- | Clip and pad a multi-line string to fill the specified width and height.fitto::Int->Int->String->Stringfittowhs=intercalate"\n"$takeh$rows++repeatblanklinewhererows=map(fitw)$linessfitw=takew.(++repeat' ')blankline=replicatew' '-- encoded platform strings-- | A platform string is a string value from or for the operating system,-- such as a file path or command-line argument (or environment variable's-- name or value ?). On some platforms (such as unix) these are not real-- unicode strings but have some encoding such as UTF-8. This alias does-- no type enforcement but aids code clarity.typePlatformString=String-- | Convert a possibly encoded platform string to a real unicode string.-- We decode the UTF-8 encoding recommended for unix systems-- (cf http://www.dwheeler.com/essays/fixing-unix-linux-filenames.html)-- and leave anything else unchanged.fromPlatformString::PlatformString->StringfromPlatformStrings=ifUTF8.isUTF8EncodedsthenUTF8.decodeStringselses-- | Convert a unicode string to a possibly encoded platform string.-- On unix we encode with the recommended UTF-8-- (cf http://www.dwheeler.com/essays/fixing-unix-linux-filenames.html)-- and elsewhere we leave it unchanged.toPlatformString::String->PlatformStringtoPlatformString=caseosof"unix"->UTF8.encodeString"linux"->UTF8.encodeString"darwin"->UTF8.encodeString_->id-- | A version of error that's better at displaying unicode.error'::String->aerror'=error.toPlatformString-- | A version of userError that's better at displaying unicode.userError'::String->IOErroruserError'=userError.toPlatformString-- mathdifforzero::(Numa,Orda)=>a->a->adifforzeroab=maximum[(a-b),0]-- regexpscontainsRegex::String->String->BoolcontainsRegexrs=casematchRegexPR("(?i)"++r)sofJust_->True_->False-- listssplitAtElement::Eqa=>a->[a]->[[a]]splitAtElementel=casedropWhile(e==)lof[]->[]l'->first:splitAtElementerestwhere(first,rest)=break(e==)l'-- treesroot=rootLabelsubs=subForestbranches=subForest-- | List just the leaf nodes of a treeleaves::Treea->[a]leaves(Nodev[])=[v]leaves(Node_branches)=concatMapleavesbranches-- | get the sub-tree rooted at the first (left-most, depth-first) occurrence-- of the specified node valuesubtreeat::Eqa=>a->Treea->Maybe(Treea)subtreeatvt|roott==v=Justt|otherwise=subtreeinforestv$subst-- | get the sub-tree for the specified node value in the first tree in-- forest in which it occurs.subtreeinforest::Eqa=>a->[Treea]->Maybe(Treea)subtreeinforest_[]=Nothingsubtreeinforestv(t:ts)=case(subtreeatvt)ofJustt'->Justt'Nothing->subtreeinforestvts-- | remove all nodes past a certain depthtreeprune::Int->Treea->Treeatreeprune0t=Node(roott)[]treeprunedt=Node(roott)(map(treeprune$d-1)$branchest)-- | apply f to all tree nodestreemap::(a->b)->Treea->Treebtreemapft=Node(f$roott)(map(treemapf)$branchest)-- | remove all subtrees whose nodes do not fulfill predicatetreefilter::(a->Bool)->Treea->Treeatreefilterft=Node(roott)(map(treefilterf)$filter(treeanyf)$branchest)-- | is predicate true in any node of tree ?treeany::(a->Bool)->Treea->Booltreeanyft=f(roott)||any(treeanyf)(branchest)-- treedrop -- remove the leaves which do fulfill predicate. -- treedropall -- do this repeatedly.-- | show a compact ascii representation of a treeshowtree::Showa=>Treea->Stringshowtree=unlines.filter(containsRegex"[^ \\|]").lines.drawTree.treemapshow-- | show a compact ascii representation of a forestshowforest::Showa=>Foresta->Stringshowforest=concatMapshowtree-- debugging-- | trace (print on stdout at runtime) a showable expression-- (for easily tracing in the middle of a complex expression)strace::Showa=>a->astracea=trace(showa)a-- | labelled trace - like strace, with a label prependedltrace::Showa=>String->a->altracela=trace(l++": "++showa)a-- | monadic trace - like strace, but works as a standalone line in a monadmtrace::(Monadm,Showa)=>a->mamtracea=stracea`seq`returna-- | trace an expression using a custom show functiontracewithfe=trace(fe)e-- parsingchoice'::[GenParsertoksta]->GenParsertokstachoice'=choice.mapText.ParserCombinators.Parsec.tryparsewith::Parsera->String->EitherParseErroraparsewithp=parsep""parseWithCtx::b->GenParserCharba->String->EitherParseErroraparseWithCtxctxp=runParserpctx""fromparse::EitherParseErrora->afromparse=eitherparseerroridparseerrore=error'$showParseErroreshowParseErrore="parse error at "++showeshowDateParseErrore=printf"date parse error (%s)"(intercalate", "$tail$lines$showe)nonspace::GenParserCharstCharnonspace=satisfy(not.isSpace)spacenonewline::GenParserCharstCharspacenonewline=satisfy(`elem`" \v\f\t")restofline::GenParserCharstStringrestofline=anyChar`manyTill`newline-- timegetCurrentLocalTime::IOLocalTimegetCurrentLocalTime=dot<-getCurrentTimetz<-getCurrentTimeZonereturn$utcToLocalTimetzt-- testing-- | Get a Test's label, or the empty string.tname::Test->Stringtname(TestLabeln_)=ntname_=""-- | Flatten a Test containing TestLists into a list of single tests.tflatten::Test->[Test]tflatten(TestLabel_t@(TestList_))=tflattenttflatten(TestListts)=concatMaptflattentstflattent=[t]-- | Filter TestLists in a Test, recursively, preserving the structure.tfilter::(Test->Bool)->Test->Testtfilterp(TestLabellts)=TestLabell(tfilterpts)tfilterp(TestListts)=TestList$filter(anyp.tflatten)$map(tfilterp)tstfilter_t=t-- | Simple way to assert something is some expected value, with no label.is::(Eqa,Showa)=>a->a->Assertiona`is`e=assertEqual""ea-- | Assert a parse result is successful, printing the parse error on failure.assertParse::(EitherParseErrora)->AssertionassertParseparse=either(assertFailure.show)(const(return()))parse-- | Assert a parse result is some expected value, printing the parse error on failure.assertParseEqual::(Showa,Eqa)=>(EitherParseErrora)->a->AssertionassertParseEqualparseexpected=either(assertFailure.show)(`is`expected)parseprintParseError::(Showa)=>a->IO()printParseErrore=doputStr"parse error at ";printe-- miscisLeft::Eitherab->BoolisLeft(Left_)=TrueisLeft_=FalseisRight::Eitherab->BoolisRight=not.isLeft-- -- | Expand ~ in a file path (does not handle ~name).-- tildeExpand :: FilePath -> IO FilePath-- tildeExpand ('~':[]) = getHomeDirectory-- tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))-- --handle ~name, requires -fvia-C or ghc 6.8:-- --import System.Posix.User-- -- tildeExpand ('~':xs) = do let (user, path) = span (/= '/') xs-- -- pw <- getUserEntryForName user-- -- return (homeDirectory pw ++ path)-- tildeExpand xs = return xs-- | Apply a function the specified number of times. Possibly uses O(n) stack ?applyN::Int->(a->a)->a->aapplyNnf=(!!n).iteratef