module Darcs.Patch.Bracketed
    ( Bracketed(..), mapBracketed, unBracketed
    , BracketedFL, mapBracketedFLFL, unBracketedFL
    ) where

import Darcs.Prelude

import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Show ( ShowPatchBasic(..) )
import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL, mapFL_FL, concatFL )
import Darcs.Util.Printer ( vcat, blueText, ($$) )


-- |This type exists for legacy support of on-disk format patch formats.
-- It is a wrapper type that explicitly tracks the nesting of braces and parens
-- in the on-disk representation of such patches. It is used as an intermediate
-- form when reading such patches normally, and also for round-tripping such
-- patches when checking the hash in bundles.
-- It shouldn't be used for anything else.
data Bracketed p wX wY where
  Singleton :: p wX wY -> Bracketed p wX wY            -- A single patch, not wrapped in anything
  Braced :: BracketedFL p wX wY -> Bracketed p wX wY   -- A list of patches, wrapped in {}
  Parens :: BracketedFL p wX wY -> Bracketed p wX wY   -- A list of patches, wrapped in ()

type BracketedFL p wX wY = FL (Bracketed p) wX wY

unBracketed :: Bracketed p wX wY -> FL p wX wY
unBracketed :: forall (p :: * -> * -> *) wX wY. Bracketed p wX wY -> FL p wX wY
unBracketed (Singleton p wX wY
p) = p wX wY
p p wX wY -> FL p wY wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
unBracketed (Braced BracketedFL p wX wY
ps) = BracketedFL p wX wY -> FL p wX wY
forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL BracketedFL p wX wY
ps
unBracketed (Parens BracketedFL p wX wY
ps) = BracketedFL p wX wY -> FL p wX wY
forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL BracketedFL p wX wY
ps

unBracketedFL :: BracketedFL p wX wY -> FL p wX wY
unBracketedFL :: forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL = FL (FL p) wX wY -> FL p wX wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL p) wX wY -> FL p wX wY)
-> (BracketedFL p wX wY -> FL (FL p) wX wY)
-> BracketedFL p wX wY
-> FL p wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. Bracketed p wW wY -> FL p wW wY)
-> BracketedFL p wX wY -> FL (FL p) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL Bracketed p wW wY -> FL p wW wY
forall wW wY. Bracketed p wW wY -> FL p wW wY
forall (p :: * -> * -> *) wX wY. Bracketed p wX wY -> FL p wX wY
unBracketed

mapBracketed :: (forall wA wB . p wA wB -> q wA wB) -> Bracketed p wX wY -> Bracketed q wX wY
mapBracketed :: forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> q wA wB)
-> Bracketed p wX wY -> Bracketed q wX wY
mapBracketed forall wA wB. p wA wB -> q wA wB
f (Singleton p wX wY
p) = q wX wY -> Bracketed q wX wY
forall (p :: * -> * -> *) wX wY. p wX wY -> Bracketed p wX wY
Singleton (p wX wY -> q wX wY
forall wA wB. p wA wB -> q wA wB
f p wX wY
p)
mapBracketed forall wA wB. p wA wB -> q wA wB
f (Braced BracketedFL p wX wY
ps) = BracketedFL q wX wY -> Bracketed q wX wY
forall (p :: * -> * -> *) wX wY.
BracketedFL p wX wY -> Bracketed p wX wY
Braced ((forall wA wB. p wA wB -> q wA wB)
-> BracketedFL p wX wY -> BracketedFL q wX wY
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> q wA wB)
-> BracketedFL p wX wY -> BracketedFL q wX wY
mapBracketedFLFL p wA wB -> q wA wB
forall wA wB. p wA wB -> q wA wB
f BracketedFL p wX wY
ps)
mapBracketed forall wA wB. p wA wB -> q wA wB
f (Parens BracketedFL p wX wY
ps) = BracketedFL q wX wY -> Bracketed q wX wY
forall (p :: * -> * -> *) wX wY.
BracketedFL p wX wY -> Bracketed p wX wY
Parens ((forall wA wB. p wA wB -> q wA wB)
-> BracketedFL p wX wY -> BracketedFL q wX wY
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> q wA wB)
-> BracketedFL p wX wY -> BracketedFL q wX wY
mapBracketedFLFL p wA wB -> q wA wB
forall wA wB. p wA wB -> q wA wB
f BracketedFL p wX wY
ps)

mapBracketedFLFL :: (forall wA wB . p wA wB -> q wA wB) -> BracketedFL p wX wY -> BracketedFL q wX wY
mapBracketedFLFL :: forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> q wA wB)
-> BracketedFL p wX wY -> BracketedFL q wX wY
mapBracketedFLFL forall wA wB. p wA wB -> q wA wB
f = (forall wW wY. Bracketed p wW wY -> Bracketed q wW wY)
-> FL (Bracketed p) wX wY -> FL (Bracketed q) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL ((forall wA wB. p wA wB -> q wA wB)
-> Bracketed p wW wY -> Bracketed q wW wY
forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
(forall wA wB. p wA wB -> q wA wB)
-> Bracketed p wX wY -> Bracketed q wX wY
mapBracketed p wA wB -> q wA wB
forall wA wB. p wA wB -> q wA wB
f)

instance PatchListFormat (Bracketed p)

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

-- 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.