{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.Bracketed.Instances () where

import Darcs.Patch.Bracketed ( Bracketed(..) )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.Prim ( FromPrim(..), PrimPatchBase(..) )
import Darcs.Patch.Show ( ShowPatchBasic(..) )

import Darcs.Patch.Witnesses.Ordered ( FL(NilFL), mapFL )

import Darcs.Util.Printer ( vcat, blueText, ($$) )

-- The PrimPatchBase, Effect and FromPrim instances are only
-- needed (by Darcs.Patch.Bundle) because the ReadPatch instance for
-- WrappedNamed unconditionally has them as requirements even though
-- they are only needed for the 'IsRebase case which isn't itself used
-- by Darcs.Patch.Bundle.
-- TODO see if this can be simplified
instance PrimPatchBase p => PrimPatchBase (Bracketed p) where
    type PrimOf (Bracketed p) = PrimOf p

instance Effect p => Effect (Bracketed p) where
    effect (Singleton p) = effect p
    effect (Braced ps) = effect ps
    effect (Parens ps) = effect ps

    effectRL (Singleton p) = effectRL p
    effectRL (Braced ps) = effectRL ps
    effectRL (Parens ps) = effectRL ps

instance FromPrim p => FromPrim (Bracketed p) where
    fromPrim p = Singleton (fromPrim p)

instance ShowPatchBasic p => ShowPatchBasic (Bracketed p) where
    showPatch f (Singleton p) = showPatch f p
    showPatch _ (Braced NilFL) = blueText "{" $$ blueText "}"
    showPatch f (Braced ps) = blueText "{" $$ vcat (mapFL (showPatch f) ps) $$ blueText "}"
    showPatch f (Parens ps) = blueText "(" $$ vcat (mapFL (showPatch f) ps) $$ blueText ")"

-- the ReadPatch instance is defined in Darcs.Patch.Read as it is
-- used as an intermediate form during reading of lists of patches
-- that are specified as ListFormatV1 or ListFormatV2.