module Darcs.Bug ( _bug, _bugDoc, _impossible, _fromJust
) where
import System.IO.Unsafe ( unsafePerformIO )
import Text.Regex ( matchRegex, mkRegex )
import Autoconf( darcs_version )
import Printer ( Doc, errorDoc, text, ($$), (<+>) )
type BugStuff = (String, Int, String, String)
type FetchUrl = String -> IO String
_bug :: FetchUrl -> BugStuff -> String -> a
_bug fetchUrl bs s = _bugDoc fetchUrl bs (text s)
_bugDoc :: FetchUrl -> BugStuff -> Doc -> a
_bugDoc fetchUrl bs s =
errorDoc $ text "bug in darcs!" $$ s <+> text ("at "++_bugLoc bs) $$
unsafePerformIO ((mkms . lines) `fmap` (fetchUrl "http://darcs.net/maintenance"
`catch` \_ -> return ""))
where mkms [] = text "I'm unable to check http://darcs.net/maintenance to see if this version is supported."
$$ text "If it is supported, please report this to bugs@darcs.net"
$$ text "If possible include the output of 'darcs --exact-version'."
mkms (a:b:r) = case matchRegex (mkRegex a) darcs_version of
Nothing -> mkms r
Just _ -> case reads b of
[(m,"")] -> text m
_ -> mkms r
mkms [_] = mkms []
_bugLoc :: BugStuff -> String
_bugLoc (file, line, date, time) = file++":"++show line++" compiled "++time++" "++date
_impossible :: FetchUrl -> BugStuff -> a
_impossible fetchUrl bs = _bug fetchUrl bs $ "Impossible case at "++_bugLoc bs
_fromJust :: FetchUrl -> BugStuff -> Maybe a -> a
_fromJust fetchUrl bs mx =
case mx of Nothing -> _bug fetchUrl bs $ "fromJust error at "++_bugLoc bs
Just x -> x