-- it is stupid that we need UndecidableInstances just to call another
-- type function (see instance Apply below which requires this)
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Darcs.Patch.V1.Prim ( Prim(..) ) where

import Prelude ()
import Darcs.Prelude

import Data.Coerce ( coerce )

import Darcs.Patch.Annotate ( Annotate(..) )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format
    ( PatchListFormat(..)
    , ListFormat(ListFormatV1)
    , FileNameFormat(OldFormat,UserFormat) )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Patch.Invert ( Invert )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Repair ( RepairToFL(..) )
import Darcs.Patch.Show
    ( ShowPatchBasic(..)
    , ShowPatchFor(..)
    , ShowPatch(..)
    , ShowContextPatch(..)
    )
import Darcs.Patch.Summary ( plainSummaryPrim, plainSummaryPrims )

import Darcs.Patch.Witnesses.Eq ( Eq2 )
import Darcs.Patch.Witnesses.Show
    ( Show1(..), Show2(..)
    , ShowDict(ShowDictClass)
    , appPrec, showsPrec2
    )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )

import Darcs.Patch.Prim.Class
    ( PrimConstruct(..), PrimCanonize(..)
    , PrimClassify(..), PrimDetails(..)
    , PrimShow(..), PrimRead(..)
    , PrimApply(..)
    , PrimPatch, PrimPatchBase(..)
    , FromPrim(..), ToFromPrim(..)
    , PrimPatchCommon
    )
import qualified Darcs.Patch.Prim.V1 as Base ( Prim )

newtype Prim x y = Prim { unPrim :: Base.Prim x y } deriving
    ( Annotate
    , Commute
    , Invert
    , IsHunk
    , Eq2
    , PatchInspect
    , PrimApply
    , PrimCanonize
    , PrimClassify
    , PrimConstruct
    , PrimDetails
    , PrimPatchCommon
    )

instance PrimPatch Prim

instance Show (Prim wX wY)  where
  showsPrec d (Prim p) =
    showParen (d > appPrec) $ showString "Prim " . showsPrec2 (appPrec + 1) p

instance Show1 (Prim wX) where
  showDict1 = ShowDictClass

instance Show2 Prim where
  showDict2 = ShowDictClass

instance PrimPatchBase Prim where
  type PrimOf Prim = Prim

instance FromPrim Prim where
  fromPrim = id

instance ToFromPrim Prim where
  toPrim = Just

instance ReadPatch Prim where
  readPatch' = do
    Sealed p <- readPrim OldFormat
    return (Sealed (Prim p))

fileNameFormat :: ShowPatchFor -> FileNameFormat
fileNameFormat ForDisplay = UserFormat
fileNameFormat ForStorage = OldFormat

instance ShowPatchBasic Prim where
  showPatch fmt = showPrim (fileNameFormat fmt) . unPrim

instance ShowContextPatch Prim where
  showContextPatch f = showPrimCtx (fileNameFormat f) . unPrim

instance ShowPatch Prim where
  summary = plainSummaryPrim . unPrim
  summaryFL = plainSummaryPrims False
  thing _ = "change"

instance PatchListFormat Prim where
  patchListFormat = ListFormatV1

instance Apply Prim where
  type ApplyState Prim = ApplyState Base.Prim
  apply = apply . unPrim

instance RepairToFL Prim where
  applyAndTryToFixFL = fmap coerce . applyAndTryToFixFL . unPrim