module Darcs.Test.Patch.Check ( PatchCheck(), do_check, file_exists, dir_exists,
remove_file, remove_dir, create_file, create_dir,
insert_line, delete_line, is_valid, do_verbose_check,
file_empty,
check_move, modify_file, FileContents(..)
) where
import System.IO.Unsafe ( unsafePerformIO )
import qualified Data.ByteString as B (ByteString)
import Data.List ( isPrefixOf, inits )
import Control.Monad.State ( State, evalState, runState )
import Control.Monad.State.Class ( get, put, modify )
import Data.Map ( Map )
import qualified Data.Map as M ( mapKeys, delete, insert, empty, lookup, null )
import System.FilePath ( joinPath, splitDirectories )
data FileContents = FC { fc_lines :: Map Int B.ByteString
, fc_maxline :: Int
} deriving (Eq, Show)
data Prop = FileEx String | DirEx String | NotEx String
| FileLines String FileContents
deriving (Eq)
data KnownState = P [Prop] [Prop]
| Inconsistent
deriving (Show)
instance Show Prop where
show (FileEx f) = "FileEx "++f
show (DirEx d) = "DirEx "++d
show (NotEx f) = "NotEx"++f
show (FileLines f l) = "FileLines "++f++": "++show l
type PatchCheck = State KnownState
empty_filecontents :: FileContents
empty_filecontents = FC M.empty 0
handle_inconsistent :: a
-> PatchCheck a
-> PatchCheck a
handle_inconsistent v a = do state <- get
case state of
Inconsistent -> return v
_ -> a
do_check :: PatchCheck a -> a
do_check p = evalState p (P [] [])
do_verbose_check :: PatchCheck a -> a
do_verbose_check p =
case runState p (P [] []) of
(b, pc) -> unsafePerformIO $ do putStrLn $ show pc
return b
is_valid :: PatchCheck Bool
is_valid = handle_inconsistent False (return True)
has :: Prop -> [Prop] -> Bool
has _ [] = False
has k (k':ks) = k == k' || has k ks
modify_file :: String
-> (Maybe FileContents -> Maybe FileContents)
-> PatchCheck Bool
modify_file f change = do
file_exists f
c <- file_contents f
case change c of
Nothing -> assert_not $ FileEx f
Just c' -> do set_contents f c'
is_valid
insert_line :: String -> Int -> B.ByteString -> PatchCheck Bool
insert_line f n l = do
c <- file_contents f
case c of
Nothing -> assert_not $ FileEx f
Just c' -> do
let lines' = M.mapKeys (\k -> if k >= n then k+1 else k) (fc_lines c')
lines'' = M.insert n l lines'
maxline' = max n (fc_maxline c')
set_contents f (FC lines'' maxline')
return True
delete_line :: String -> Int -> B.ByteString -> PatchCheck Bool
delete_line f n l = do
c <- file_contents f
case c of
Nothing -> assert_not $ FileEx f
Just c' ->
let flines = fc_lines c'
flines' = M.mapKeys (\k -> if k > n then k1 else k)
(M.delete n flines)
maxlinenum' | n <= fc_maxline c' = fc_maxline c' 1
| otherwise = n 1
c'' = FC flines' maxlinenum'
do_delete = do
set_contents f c''
is_valid
in case M.lookup n flines of
Nothing -> do_delete
Just l' -> if l == l'
then do_delete
else assert_not $ FileEx f
set_contents :: String -> FileContents -> PatchCheck ()
set_contents f c = handle_inconsistent () $ do
P ks nots <- get
let ks' = FileLines f c : filter (not . is_file_lines_for f) ks
put (P ks' nots)
where is_file_lines_for file prop = case prop of
FileLines f' _ -> file == f'
_ -> False
file_contents :: String -> PatchCheck (Maybe FileContents)
file_contents f = handle_inconsistent Nothing $ do
P ks _ <- get
return (fic ks)
where fic (FileLines f' c:_) | f == f' = Just c
fic (_:ks) = fic ks
fic [] = Just empty_filecontents
file_empty :: String
-> PatchCheck Bool
file_empty f = do
c <- file_contents f
let empty = case c of
Just c' -> fc_maxline c' == 0 && M.null (fc_lines c')
Nothing -> True
if empty
then do set_contents f empty_filecontents
is_valid
else assert_not $ FileEx f
return empty
movedirfilename :: String -> String -> String -> String
movedirfilename d d' f
| (d ++ "/") `isPrefixOf` f = d' ++ drop (length d) f
| f == d = d'
| otherwise = f
do_swap :: String -> String -> PatchCheck Bool
do_swap f f' = handle_inconsistent False $ do
modify (\(P ks nots) -> P (map sw ks) (map sw nots))
return True
where sw (FileEx a) | f `is_soe` a = FileEx $ movedirfilename f f' a
| f' `is_soe` a = FileEx $ movedirfilename f' f a
sw (DirEx a) | f `is_soe` a = DirEx $ movedirfilename f f' a
| f' `is_soe` a = DirEx $ movedirfilename f' f a
sw (FileLines a c) | f `is_soe` a = FileLines (movedirfilename f f' a) c
| f' `is_soe` a = FileLines (movedirfilename f' f a) c
sw (NotEx a) | f `is_soe` a = NotEx $ movedirfilename f f' a
| f' `is_soe` a = NotEx $ movedirfilename f' f a
sw p = p
is_soe d1 d2 =
d1 == d2 || (d1 ++ "/") `isPrefixOf` d2
assert :: Prop -> PatchCheck Bool
assert p = handle_inconsistent False $ do
P ks nots <- get
if has p nots
then do
put Inconsistent
return False
else if has p ks
then return True
else do
put (P (p:ks) nots)
return True
assert_not :: Prop -> PatchCheck Bool
assert_not p = handle_inconsistent False $ do
P ks nots <- get
if has p ks
then do
put Inconsistent
return False
else if has p nots
then return True
else do
put (P ks (p:nots))
return True
change_to_true :: Prop -> PatchCheck Bool
change_to_true p = handle_inconsistent False $ do
modify (\(P ks nots) -> P (p:ks) (filter (p /=) nots))
return True
change_to_false :: Prop -> PatchCheck Bool
change_to_false p = handle_inconsistent False $ do
modify (\(P ks nots) -> P (filter (p /=) ks) (p:nots))
return True
assert_file_exists :: String -> PatchCheck Bool
assert_file_exists f = do assert_not $ NotEx f
assert_not $ DirEx f
assert $ FileEx f
assert_dir_exists :: String -> PatchCheck Bool
assert_dir_exists d = do assert_not $ NotEx d
assert_not $ FileEx d
assert $ DirEx d
assert_exists :: String -> PatchCheck Bool
assert_exists f = assert_not $ NotEx f
assert_no_such :: String -> PatchCheck Bool
assert_no_such f = do assert_not $ FileEx f
assert_not $ DirEx f
assert $ NotEx f
create_file :: String -> PatchCheck Bool
create_file fn = do
superdirs_exist fn
assert_no_such fn
change_to_true (FileEx fn)
change_to_false (NotEx fn)
create_dir :: String -> PatchCheck Bool
create_dir fn = do
substuff_dont_exist fn
superdirs_exist fn
assert_no_such fn
change_to_true (DirEx fn)
change_to_false (NotEx fn)
remove_file :: String -> PatchCheck Bool
remove_file fn = do
superdirs_exist fn
assert_file_exists fn
file_empty fn
change_to_false (FileEx fn)
change_to_true (NotEx fn)
remove_dir :: String -> PatchCheck Bool
remove_dir fn = do
substuff_dont_exist fn
superdirs_exist fn
assert_dir_exists fn
change_to_false (DirEx fn)
change_to_true (NotEx fn)
check_move :: String -> String -> PatchCheck Bool
check_move f f' = do
superdirs_exist f
superdirs_exist f'
assert_exists f
assert_no_such f'
do_swap f f'
substuff_dont_exist :: String -> PatchCheck Bool
substuff_dont_exist d = handle_inconsistent False $ do
P ks _ <- get
if all noss ks
then return True
else do
put Inconsistent
return False
where noss (FileEx f) = not (is_within_dir f)
noss (DirEx f) = not (is_within_dir f)
noss _ = True
is_within_dir f = (d ++ "/") `isPrefixOf` f
superdirs_exist :: String -> PatchCheck Bool
superdirs_exist fn = and `fmap` mapM assert_dir_exists superdirs
where superdirs = map (("./"++) . joinPath)
(init (tail (inits (tail (splitDirectories fn)))))
file_exists :: String -> PatchCheck Bool
file_exists fn = do
superdirs_exist fn
assert_file_exists fn
dir_exists :: String -> PatchCheck Bool
dir_exists fn = do
superdirs_exist fn
assert_dir_exists fn