-- Copyright (C) 2002-2003 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

module Darcs.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, Possibly(..)
                  ) where

import Text.Regex ( mkRegex, matchRegex )
import System.IO.Unsafe ( unsafePerformIO )
import qualified Data.ByteString as B (ByteString)
import Data.List (isPrefixOf)

newtype PatchCheck a = PC( KnownState -> (KnownState, a) )

data Possibly a = PJust a | PNothing | PSomething
                  deriving (Eq, Show)
data Prop = FileEx String | DirEx String | NotEx String
          | FileLines String [Possibly B.ByteString]
            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 (take 10 l)

instance Monad PatchCheck where
    (PC p) >>= k  =  PC( \s0 -> let (s1, a) = p s0
                                    (PC q) = k a
                                in q s1 )
    return a = PC( \s -> (s, a) )

do_check :: PatchCheck a -> a
do_check (PC p) = snd $ p (P [] [])

do_verbose_check :: PatchCheck a -> a
do_verbose_check (PC p) =
    case p (P [] []) of
    (pc, b) -> unsafePerformIO $ do putStrLn $ show pc
                                    return b

is_valid :: PatchCheck Bool
is_valid = PC iv
    where iv Inconsistent = (Inconsistent, False)
          iv m = (m, True)

has :: Prop -> [Prop] -> Bool
has _ [] = False
has k (k':ks) = k == k' || has k ks

modify_file :: String
            -> ([Possibly B.ByteString]-> Maybe [Possibly B.ByteString])
            -> PatchCheck Bool
modify_file f change = do
    file_exists f
    c <- file_contents f
    case change c of
      Nothing -> assert_not $ FileEx f -- shorthand for "FAIL"
      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 il n c of
       [] -> assert_not $ FileEx f
       c' -> do
             set_contents f c'
             return True
  where il 1 mls = (PJust l:mls)
        il i (ml:mls) = ml : il (i-1) mls
        il _ [] = []

-- deletes a line from a hunk patch (third argument) in the given file (first
-- argument) at the given line number (second argument)
delete_line :: String -> Int -> B.ByteString -> PatchCheck Bool
delete_line f n l = do
    c <- file_contents f
    case dl [] n c of
        Nothing -> assert_not $ FileEx f
        Just c' -> do
            set_contents f c'
            is_valid
  where dl _ _ [] = Nothing
        dl o 1 (ml':ls) =
            case ml' of
            PSomething -> Just $ reverse o ++ ls
            PNothing -> Just $ reverse o ++ ls
            PJust l' -> if l' == l then Just $ reverse o ++ ls
                                   else Nothing
        dl o i (ml:mls) =
            case ml of
            PNothing -> dl (PSomething:o) (i-1) mls
            _ -> dl (ml:o) (i-1) mls

set_contents :: String -> [Possibly B.ByteString] -> PatchCheck ()
set_contents f mss = PC (sc f mss)
sc :: String -> [Possibly B.ByteString] -> KnownState -> (KnownState,())
sc f mss (P ks nots) = (P (scl [] f mss ks) nots, ())
sc _ _ Inconsistent = (Inconsistent, ())
scl :: [Prop] -> String -> [Possibly B.ByteString] -> [Prop] -> [Prop]
scl olds f mss [] = FileLines f mss : olds
scl olds f mss (FileLines f' mss':ks)
    | f == f' = FileLines f mss : (olds++ks)
    | f /= f' = scl (FileLines f' mss':olds) f mss ks
scl olds f mss (k:ks) = scl (k:olds) f mss ks

file_contents :: String -> PatchCheck [Possibly B.ByteString]
file_contents f = PC fc
    where fc Inconsistent = (Inconsistent, [])
          fc (P ks nots) = (P ks nots, fic ks)
          fic (FileLines f' mss:_) | f == f' = mss
          fic (_:ks) = fic ks
          fic [] = repeat PNothing

file_empty :: String -> PatchCheck Bool
file_empty f = do
  c <- file_contents f
  let empty = all (PNothing ==) $ take 101 c
  if empty
     then do set_contents f []
             is_valid
     -- Crude way to make it inconsistent and return false:
     else assert_not $ FileEx f
  return empty

movedirfilename :: String -> String -> String -> String
movedirfilename d d' f =
    if (d ++ "/") `isPrefixOf` f
    then d'++drop (length d) f
    else if f == d
         then d'
         else f

do_swap :: String -> String -> PatchCheck Bool
do_swap f f' = PC swfn
  where swfn Inconsistent = (Inconsistent, False)
        swfn (P ks nots) = (P (map sw ks) (map sw nots), True)
        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 ls) | f  `is_soe` a = FileLines (movedirfilename f f' a) ls
                            | f' `is_soe` a = FileLines (movedirfilename f' f a) ls
        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 = -- is_superdir_or_equal
            d1 == d2 || (d1 ++ "/") `isPrefixOf` d2

assert :: Prop -> PatchCheck Bool
assert p = PC assertfn
    where assertfn Inconsistent = (Inconsistent, False)
          assertfn (P ks nots) =
              if has p nots then (Inconsistent, False)
              else if has p ks then (P ks nots, True)
              else (P (p:ks) nots, True)

assert_not :: Prop -> PatchCheck Bool
assert_not p = PC assertnfn
    where assertnfn Inconsistent = (Inconsistent, False)
          assertnfn (P ks nots) =
              if has p ks then (Inconsistent, False)
              else if has p nots then (P ks nots, True)
              else (P ks (p:nots), True)

change_to_true :: Prop -> PatchCheck Bool
change_to_true p = PC chtfn
    where chtfn Inconsistent = (Inconsistent, False)
          chtfn (P ks nots) = (P (p:ks) (filter (p /=) nots), True)

change_to_false :: Prop -> PatchCheck Bool
change_to_false p = PC chffn
    where chffn Inconsistent = (Inconsistent, False)
          chffn (P ks nots) = (P (filter (p /=) ks) (p:nots), 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 = PC ssde
    where ssde Inconsistent = (Inconsistent, False)
          ssde (P ks nots) = if all noss ks
                             then (P ks nots, True)
                             else (Inconsistent, 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 =
  case matchRegex (mkRegex "\\./(.+)/[^/]+") fn of
  Just ["."] -> return True
  Just [d] -> do
                a <- assert_dir_exists ("./"++d)
                b <- superdirs_exist ("./"++d)
                return $! a && b
  _ -> is_valid

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