{-# 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 :: Bracketed p wX wY -> FL (PrimOf (Bracketed p)) wX wY
effect (Singleton p :: p wX wY
p) = p wX wY -> FL (PrimOf p) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect p wX wY
p
    effect (Braced ps :: BracketedFL p wX wY
ps) = BracketedFL p wX wY -> FL (PrimOf (FL (Bracketed p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect BracketedFL p wX wY
ps
    effect (Parens ps :: BracketedFL p wX wY
ps) = BracketedFL p wX wY -> FL (PrimOf (FL (Bracketed p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect BracketedFL p wX wY
ps

    effectRL :: Bracketed p wX wY -> RL (PrimOf (Bracketed p)) wX wY
effectRL (Singleton p :: p wX wY
p) = p wX wY -> RL (PrimOf p) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> RL (PrimOf p) wX wY
effectRL p wX wY
p
    effectRL (Braced ps :: BracketedFL p wX wY
ps) = BracketedFL p wX wY -> RL (PrimOf (FL (Bracketed p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> RL (PrimOf p) wX wY
effectRL BracketedFL p wX wY
ps
    effectRL (Parens ps :: BracketedFL p wX wY
ps) = BracketedFL p wX wY -> RL (PrimOf (FL (Bracketed p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> RL (PrimOf p) wX wY
effectRL BracketedFL p wX wY
ps

instance FromPrim p => FromPrim (Bracketed p) where
    fromPrim :: PrimOf (Bracketed p) wX wY -> Bracketed p wX wY
fromPrim p :: PrimOf (Bracketed p) wX wY
p = p wX wY -> Bracketed p wX wY
forall (p :: * -> * -> *) wX wY. p wX wY -> Bracketed p wX wY
Singleton (PrimOf p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromPrim PrimOf p wX wY
PrimOf (Bracketed p) wX wY
p)

instance ShowPatchBasic p => ShowPatchBasic (Bracketed p) where
    showPatch :: ShowPatchFor -> Bracketed p wX wY -> Doc
showPatch f :: ShowPatchFor
f (Singleton p :: p wX wY
p) = ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f p wX wY
p
    showPatch _ (Braced NilFL) = String -> Doc
blueText "{" Doc -> Doc -> Doc
$$ String -> Doc
blueText "}"
    showPatch f :: ShowPatchFor
f (Braced ps :: BracketedFL p wX wY
ps) = String -> Doc
blueText "{" Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((forall wW wZ. Bracketed p wW wZ -> Doc)
-> BracketedFL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> Bracketed p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f) BracketedFL p wX wY
ps) Doc -> Doc -> Doc
$$ String -> Doc
blueText "}"
    showPatch f :: ShowPatchFor
f (Parens ps :: BracketedFL p wX wY
ps) = String -> Doc
blueText "(" Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((forall wW wZ. Bracketed p wW wZ -> Doc)
-> BracketedFL p wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> Bracketed p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f) BracketedFL p wX wY
ps) Doc -> Doc -> Doc
$$ String -> Doc
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.