% Reporting bugs in darcs.  See also impossible.h.

\begin{code}
module Darcs.Bug ( _bug, _bugDoc,
                  _bugLoc, _impossible, _fromJust, _withBugLoc,
                 ) where

import System.IO.Unsafe ( unsafePerformIO )
import Text.Regex ( matchRegex, mkRegex )

import HTTP ( fetchUrl )
import Autoconf( darcs_version )
import Printer ( Doc, errorDoc, text, ($$), (<+>) )
\end{code}

\begin{code}
_bug :: BugStuff -> String -> a
_bug bs s = _bugDoc bs (text s)

_bugDoc :: BugStuff -> Doc -> a
_bugDoc 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 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 []
\end{code}

\begin{code}
type BugStuff = (String, Int, String, String)

_bugLoc :: BugStuff -> String
_bugLoc (file, line, date, time) = file++":"++show line++" compiled "++time++" "++date

_impossible :: BugStuff -> a
_impossible bs = _bug bs $ "Impossible case"++_bugLoc bs

_fromJust :: BugStuff -> Maybe a -> a
_fromJust bs mx =
  case mx of Nothing -> _bug bs $ "fromJust error"++_bugLoc bs
             Just x  -> x

_withBugLoc :: BugStuff -> IO a -> IO a
_withBugLoc bs job = job `catch` \err -> error $ _bugLoc bs++"\n"++show err
\end{code}