------------------------------------------------------------------------------- |-- Module : Happstack.Util.Common-- Copyright : (c) Happstack.com, 2009; (c) HAppS.org, 2005-- License : BSD3-- ---- Various helper routines.-----------------------------------------------------------------------------moduleHappstack.Util.CommonwhereimportSystem.Log.LoggerimportControl.ConcurrentimportControl.MonadimportqualifiedData.ByteString.Char8asPimportData.CharimportData.IntimportSystem.IOimportSystem.ExitimportSystem.IO.ErrorimportSystem.ProcessimportSystem.IO.UnsafeimportSystem.TimeimportControl.Arrow(first,second)typeSeconds=InttypeEpochSeconds=Int64epochSeconds::CalendarTime->EpochSecondsepochSecondsct=letTODsec_=toClockTimectinfromIntegralseceSecsToCalTime::EpochSeconds->IOCalendarTimeeSecsToCalTimes=toCalendarTime(TOD(fromIntegrals)0)epochPico::CalendarTime->IntegerepochPicoct=fromIntegral(epochSecondsct)*1000----reliable getline and putlinelogMC::Priority->String->IO()logMC=logM"Happstack.Util.Common"-- | Put a line into a handle followed by "\r\n" and echo to stdouthPutLine::Handle->String->IO()hPutLinehandleline=dohPutStrhandlelinehPutStrhandle"\r\n"hFlushhandlelogMCDEBUGlinereturn()-- | Get a line from the handle and echo to stdouthGetLn::Handle->IOStringhGetLnhandle=dolethGetLn'=doc<-hGetCharhandlecasecof'\n'->return[]'\r'->doc2<-hGetCharhandleifc2=='\n'thenreturn[]elsegetRestc_->getRestcgetRestc=fmap(c:)hGetLn'line<-hGetLn'logMCDEBUGlinereturnlineunBracket,ltrim,rtrim,trim::String->String-- | Removes the whitespace surrounding a string as well-- as the first and last character.-- @unBracket " (asdf) " = "asdf"@unBracket=tail.init.trim-- | Drops the whitespace at the start of the stringltrim=dropWhileisSpace-- | Drops the whitespace at the end of the stringrtrim=reverse.ltrim.reverse-- | Trims the beginning and ending whitespace of a stringtrim=ltrim.rtrim-- | Repeadly splits a list by the provided separator and collects the resultssplitList::Eqa=>a->[a]->[[a]]splitList_[]=[]splitListseplist=h:splitListseptwhere(h,t)=split(==sep)list-- | Repeatedly splits a list and collects the resultssplitListBy::(a->Bool)->[a]->[[a]]splitListBy_[]=[]splitListByflist=h:splitListByftwhere(h,t)=splitflist-- | Split is like break, but the matching element is dropped.split::(a->Bool)->[a]->([a],[a])splitfs=(left,right)where(left,right')=breakfsright=ifnullright'then[]elsetailright'-- | Read file with a default value if the file does not exist.mbReadFile::a->(String->a)->FilePath->IOambReadFilenothjustpath=(dotext<-readFilepath;return$justtext)`catch`\err->ifisDoesNotExistErrorerrthenreturnnothelseioErrorerrmapFst::(a->b)->[(a,x)]->[(b,x)]mapFst=map.firstmapSnd::(a->b)->[(x,a)]->[(x,b)]mapSnd=map.second-- | applies the list of functions to the provided argument revmap::a->[a->b]->[b]revmapitem=map(\f->fitem)-- | @comp f a b@ compares @a@ and @b@ after apply-- @f@.comp::Ordt=>(a->t)->a->a->Orderingcompfe1e2=fe1`compare`fe2-- | Run an external command. Upon failure print status-- to stderr.runCommand::String->[String]->IO()runCommandcmdargs=do(_,outP,errP,pid)<-runInteractiveProcesscmdargsNothingNothingletpGetContentsh=domv<-newEmptyMVarletput[]=putMVarmv[]putxs=lastxs`seq`putMVarmvxsforkIO(hGetContentsh>>=put)takeMVarmvos<-pGetContentsoutPes<-pGetContentserrPec<-waitForProcesspidcaseecofExitSuccess->return()ExitFailuree->dohPutStrLnstderr("Running process "++unwords(cmd:args)++" FAILED ("++showe++")")hPutStrLnstderroshPutStrLnstderreshPutStrLnstderr"Raising error..."fail"Running external command failed"-- | Unsafe tracing, outputs the message and the value to stderr.debug::Showa=>String->a->adebugmsgs=seq(unsafePerformIO(hPutStrstderr("DEBUG: "++msg++"\n")>>hPutStrstderr(shows++"\n")))s{-# NOINLINE debugM #-}-- | Unsafe tracing messages inside a monad.debugM::Monadm=>String->m()debugMmsg=unsafePerformIO(P.hPutStrstderr(P.pack(msg++"\n"))>>hFlushstderr)`seq`return()-- | Read in any monad.readM::(Monadm,Readt)=>String->mtreadMs=casereadssof[(v,"")]->returnv_->fail"readM: parse error"-- | Convert Maybe into an another monad. This is a simple injection that calls-- fail when given a Nothing.maybeM::Monadm=>Maybea->mamaybeM(Justx)=returnxmaybeM_=fail"maybeM: Nothing"-- | Lifts a bool into a MonadPlus, with False mapped to the mzero.boolM::(MonadPlusm)=>Bool->mBoolboolMFalse=mzeroboolMTrue=returnTrue-- | @notMb a b@ returns @Just a@ if @b@ is @Nothing@ and @Nothing@ if-- @b@ is @Just _@.notMb::a->Maybea->MaybeanotMbv1v2=maybe(Justv1)(constNothing)v2-- | Takes a list of delays, in seconds, and an action to execute-- repeatedly. The action is then executed repeatedly in a separate thread-- until the list has been consumed. The first action takes place immediately. periodic::[Int]->IO()->IOThreadIdperiodicts=forkIO.periodic'ts-- a little something to fix the types of ^infixr8.^(.^)::Int->Int->Inta.^b=a^b-- | Similar to 'periodic' but runs in the same threadperiodic'::[Int]->IOa->IOaperiodic'[]x=xperiodic'(t:ts)x=x>>threadDelay((10.^6)*t)>>periodic'tsx