Selection.hs

-- Copyright (C) 2016 G. Hoffmann

module Darcs.Test.Patch.Selection ( testSuite ) where

import Darcs.Prelude

import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit ( testCase )

import Darcs.Patch.Witnesses.Ordered ( FL(..), (:>)(..)  )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )

import Darcs.Patch.V2 ( RepoPatchV2 )
import qualified Darcs.Patch.V2.Prim as V2
import Darcs.Patch.RepoType ( RepoType(..), RebaseType(..) )

import Darcs.UI.SelectChanges
    ( PatchSelectionOptions(..)
    , selectionConfig
    , runSelection
    , WhichChanges(..)
    )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, patchInfoAndPatch )
import Darcs.Patch.Info ( rawPatchInfo )
import Darcs.UI.Options.All
    ( Verbosity(..), WithSummary(..)
    , WithContext(..), SelectDeps(..), MatchFlag(..) )

import Darcs.Test.TestOnly.Instance ()

-- A test module for interactive patch selection.

type Patch = RepoPatchV2 V2.Prim

testSuite :: Test
testSuite = testGroup "Darcs.Patch.Selection" $
  [ dontReadContents whch | whch <- [Last, LastReversed, First, FirstReversed] ]

dontReadContents :: WhichChanges -> Test
dontReadContents whch =
    testCase ("Matching on patch metadata does not open patch contents: " ++ show whch)
      $ do
   let -- here is an FL of patches whose metadata can be read but whose contents
       -- should NEVER be read, otherwise something really bad would happen.
       launchNuclearMissilesPatches = unsafeCoerceP $ lnmPatches [ "P " ++ show i | i <- [1..5::Int] ]
       lnmPatches [] = NilFL
       lnmPatches (n:names) = buildPatch n  :>: lnmPatches names
       buildPatch :: String -> PatchInfoAnd ('RepoType 'NoRebase) Patch wX wY
       buildPatch name = patchInfoAndPatch (rawPatchInfo "1999" name "harness" [] False) (error "Patch content read!")
       pso = PatchSelectionOptions
           { verbosity = Quiet
           , matchFlags = [OnePatch "."]  -- match on every patch
           , interactive = False
           , selectDeps = AutoDeps
           , withSummary = NoSummary
           , withContext = NoContext
           }
       context = selectionConfig whch "select" pso Nothing Nothing
   (unselected :> selected) <- runSelection launchNuclearMissilesPatches context
   -- Forcing selection to happen (at least to the point of knowing whether unselected
   -- and unselected are NilFL or not) should not evaluate the `undefined` inside of our
   -- patches, ie, we don't need to read too much.
   unselected `seq` selected `seq` return ()