-- Reporting bugs in darcs.  See also impossible.h.
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