    -- Copyright (C) 2006 David Roundy
    --
    -- This program is free software; you can redistribute it and/or modify
    -- it under the terms of the GNU General Public License as published by
    -- the Free Software Foundation; either version 2, or (at your option)
    -- any later version.
    --
    -- This program is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    -- GNU General Public License for more details.
    --
    -- You should have received a copy of the GNU General Public License
    -- along with this program; see the file COPYING.  If not, write to
    -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    -- Boston, MA 02110-1301, USA.

    {-# OPTIONS_GHC -cpp #-}
    {-# LANGUAGE CPP #-}

    #include "gadts.h"

    module Darcs.Hopefully ( Hopefully, PatchInfoAnd,
                             piap, n2pia, patchInfoAndPatch,
                             conscientiously, hopefully, info,
                             hopefullyM, createHashed, extractHash,
                             actually, unavailable ) where

    import System.IO.Unsafe ( unsafeInterleaveIO )

    import Darcs.SignalHandler ( catchNonSignal )
    import Printer ( Doc, renderString, errorDoc, text, ($$) )
    import Darcs.Patch.Info ( PatchInfo, human_friendly, idpatchinfo )
    import Darcs.Patch ( RepoPatch, Named, patch2patchinfo )
    import Darcs.Patch.Prim ( Effect(..), Conflict(..) )
    import Darcs.Patch.Patchy ( Patchy, ReadPatch(..), Apply(..), Invert(..),
                                ShowPatch(..), Commute(..) )
    import Darcs.Witnesses.Ordered ( MyEq, unsafeCompare, (:>)(..), (:\/:)(..), (:/\:)(..) )
    import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, mapSeal )
    import Darcs.Utils ( prettyException )

    -- | @'Hopefully' p C@ @(x y)@ is @'Either' String (p C@ @(x y))@ in a
    -- form adapted to darcs patches. The @C@ @(x y)@ represents the type
    -- witness for the patch that should be there. The @Hopefully@ type
    -- just tells whether we expect the patch to be hashed or not, and
    -- 'SimpleHopefully' does the real work of emulating
    -- 'Either'. @Hopefully sh@ represents an expected unhashed patch, and
    -- @Hashed hash sh@ represents an expected hashed patch with its hash.
    data Hopefully a C(x y) = Hopefully (SimpleHopefully a C(x y)) | Hashed String (SimpleHopefully a C(x y))

    -- | @SimpleHopefully@ is a variant of @Either String@ adapted for
    -- type witnesses. @Actually@ is the equivalent of @Right@, while
    -- @Unavailable@ is @Left@.
    data SimpleHopefully a C(x y) = Actually (a C(x y)) | Unavailable String

    -- | @'PatchInfoAnd' p C(a b)@ represents a hope we have to get a
    -- patch through its info. We're not sure we have the patch, but we
    -- know its info.
    data PatchInfoAnd p C(a b) = PIAP !PatchInfo (Hopefully (Named p) C(a b))

    fmapH :: (a C(x y) -> b C(w z)) -> Hopefully a C(x y) -> Hopefully b C(w z)
    fmapH f (Hopefully sh) = Hopefully (ff sh)
        where ff (Actually a) = Actually (f a)
              ff (Unavailable e) = Unavailable e
    fmapH f (Hashed h sh) = Hashed h (ff sh)
        where ff (Actually a) = Actually (f a)
              ff (Unavailable e) = Unavailable e

    info :: PatchInfoAnd p C(a b) -> PatchInfo
    info (PIAP i _) = i

    -- | @'piap' i p@ creates a PatchInfoAnd containing p with info i.
    piap :: PatchInfo -> Named p C(a b) -> PatchInfoAnd p C(a b)
    piap i p = PIAP i (Hopefully $ Actually p)

    -- | @n2pia@ creates a PatchInfoAnd representing a @Named@ patch.
    n2pia :: Named p C(x y) -> PatchInfoAnd p C(x y)
    n2pia x = patch2patchinfo x `piap` x

    patchInfoAndPatch :: PatchInfo -> Hopefully (Named p) C(a b) -> PatchInfoAnd p C(a b)
    patchInfoAndPatch =  PIAP

    -- | @'hopefully' hp@ tries to get a patch from a 'PatchInfoAnd'
    -- value. If it fails, it outputs an error \"failed to read patch:
    -- \<description of the patch>\". We get the description of the patch
    -- from the info part of 'hp'
    hopefully :: PatchInfoAnd p C(a b) -> Named p C(a b)
    hopefully = conscientiously $ \e -> text "failed to read patch:" $$ e

    -- | @'conscientiously' er hp@ tries to extract a patch from a 'PatchInfoAnd'.
    -- If it fails, it applies the error handling function @er@ to a description
    -- of the patch info component of @hp@.
    conscientiously :: (Doc -> Doc)
                    -> PatchInfoAnd p C(a b) -> Named p C(a b)
    conscientiously er (PIAP pinf hp) =
        case hopefully2either hp of
          Right p -> p
          Left e -> errorDoc $ er (human_friendly pinf $$ text e)

    -- | @hopefullyM@ is a version of @hopefully@ which calls @fail@ in a
    -- monad instead of erroring.
    hopefullyM :: Monad m => PatchInfoAnd p C(a b) -> m (Named p C(a b))
    hopefullyM (PIAP pinf hp) = case hopefully2either hp of
                                  Right p -> return p
                                  Left e -> fail $ renderString (human_friendly pinf $$ text e)

    -- Any recommendations for a nice adverb to name the below?
    hopefully2either :: Hopefully a C(x y) -> Either String (a C(x y))
    hopefully2either (Hopefully (Actually p)) = Right p
    hopefully2either (Hashed _ (Actually p)) = Right p
    hopefully2either (Hopefully (Unavailable e)) = Left e
    hopefully2either (Hashed _ (Unavailable e)) = Left e

    actually :: a C(x y) -> Hopefully a C(x y)
    actually = Hopefully . Actually

    createHashed :: String -> (String -> IO (Sealed (a C(x)))) -> IO (Sealed (Hopefully a C(x)))
    createHashed h f = do mapSeal (Hashed h) `fmap` unsafeInterleaveIO (f' `catchNonSignal` handler)
      where
      f' = do Sealed x <- f h
              return (Sealed (Actually x))
      handler e = return $ seal $ Unavailable $ prettyException e

    extractHash :: PatchInfoAnd p C(a b) -> Either (Named p C(a b)) String
    extractHash (PIAP _ (Hashed s _)) = Right s
    extractHash hp = Left $ conscientiously (\e -> text "unable to read patch:" $$ e) hp

    unavailable :: String -> Hopefully a C(x y)
    unavailable = Hopefully . Unavailable

    instance MyEq p => MyEq (PatchInfoAnd p) where
        unsafeCompare (PIAP i _) (PIAP i2 _) = i == i2

    --instance Invert (p C(x y)) => Invert (PatchInfoAnd (p C(x y))) where
    instance Invert p => Invert (PatchInfoAnd p) where
        identity = PIAP idpatchinfo (actually identity)
        invert (PIAP i p) = PIAP i (invert `fmapH` p)

    instance (Conflict p, Effect p, ShowPatch p) => ShowPatch (PatchInfoAnd p) where
        showPatch (PIAP n p) = case hopefully2either p of
                               Right x -> showPatch x
                               Left _ -> human_friendly n
        showContextPatch (PIAP n p) = case hopefully2either p of
                                        Right x -> showContextPatch x
                                        Left _ -> return $ human_friendly n
        description (PIAP n _) = human_friendly n
        summary (PIAP n p) = case hopefully2either p of
                             Right x -> summary x
                             Left _ -> human_friendly n
        showNicely (PIAP n p) = case hopefully2either p of
                                Right x -> showNicely x
                                Left _ -> human_friendly n

    instance Commute p => Commute (PatchInfoAnd p) where
        commute (x :> y) = do y' :> x' <- commute (hopefully x :> hopefully y)
                              return $ (info y `piap` y') :> (info x `piap` x')
        listTouchedFiles = listTouchedFiles . hopefully
        merge (x :\/: y) = case merge (hopefully x :\/: hopefully y) of
                           y' :/\: x' -> (info y `piap` y') :/\: (info x `piap` x')
        hunkMatches _ _ = error "hunkmatches not implemented for PatchInfoAnd"

    instance Apply p => Apply (PatchInfoAnd p) where
        apply opts p = apply opts $ hopefully p
        applyAndTryToFix p = do mp' <- applyAndTryToFix $ hopefully p
                                case mp' of
                                  Nothing -> return Nothing
                                  Just (e,p') -> return $ Just (e, n2pia p')

    instance ReadPatch p => ReadPatch (PatchInfoAnd p) where
        readPatch' wanteof = do x <- readPatch' wanteof
                                case x of
                                  Just (Sealed p) -> return $ Just $ Sealed $ n2pia p
                                  Nothing -> return Nothing

    instance Effect p => Effect (PatchInfoAnd p) where
        effect = effect . hopefully
        effectRL = effectRL . hopefully

    instance Conflict p => Conflict (PatchInfoAnd p) where
        listConflictedFiles = listConflictedFiles . hopefully
        resolveConflicts = resolveConflicts . hopefully
        commute_no_conflicts (x:>y) = do y':>x' <- commute_no_conflicts (hopefully x :> hopefully y)
                                         return (info y `piap` y' :> info x `piap` x')
        conflictedEffect = conflictedEffect . hopefully

    instance RepoPatch p => Patchy (PatchInfoAnd p)