{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Precis.Diff
-- Copyright   :  (c) Stephen Tetley 2010
-- License     :  BSD3
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  to be determined.
--
-- Two Diff types (3 state and 4 state)
--
--------------------------------------------------------------------------------


module Precis.Diff
  (
  
  -- * Edit types
    Edit4(..)
  , Edit3(..)

  -- * Edit operations
  , diff4
  , diff3

  , addedRemoved
  , conflictRemoved
  , addedConflictRemoved

  ) where

import Precis.Utils

import Data.List ( find )

--------------------------------------------------------------------------------

data Edit4 a = ADD a | DIF a a | EQU a | DEL a
  deriving (Eq,Show)

-- some edits are better as ADD | EQU | DEL though...

data Edit3 a = Add a | Equ a | Del a
  deriving (Eq,Show)


instance Functor Edit4 where
  fmap f (ADD a)   = ADD (f a)
  fmap f (DIF a b) = DIF (f a) (f b)
  fmap f (EQU a)   = EQU (f a)
  fmap f (DEL a)   = DEL (f a)

instance Functor Edit3 where
  fmap f (Add a)   = Add (f a)
  fmap f (Equ a)   = Equ (f a)
  fmap f (Del a)   = Del (f a)




diff4 :: (a -> a -> Bool) -> (a -> a -> Bool) -> [a] -> [a] -> [Edit4 a]
diff4 matches conflict as bs = toListH $ checkShort bs (checkLong as id)
  where
    checkLong []     f = f
    checkLong (x:xs) f = case find (matches x) bs of
        Just b | conflict x b -> checkLong xs (f `snocH` DIF x b) 
               | otherwise    -> checkLong xs (f `snocH` EQU x)
        Nothing               -> checkLong xs (f `snocH` ADD x)

    checkShort []     f = f
    checkShort (y:ys) f = case find (matches y) as of
        Just _                -> checkShort ys f   -- already found
        Nothing               -> checkShort ys (f `snocH` DEL y)


diff3 :: (a -> a -> Bool) -> [a] -> [a] -> [Edit3 a]
diff3 matches as bs = toListH $ checkShort bs (checkLong as id)
  where
    checkLong []     f = f
    checkLong (x:xs) f = case find (matches x) bs of
        Just _    -> checkLong xs (f `snocH` Equ x)
        Nothing   -> checkLong xs (f `snocH` Add x) 

    checkShort []     f = f
    checkShort (y:ys) f = case find (matches y) as of
        Just _    -> checkShort ys f          -- already found
        Nothing   -> checkShort ys (f `snocH` Del y) 


addedRemoved :: [Edit4 a] -> ([a],[a])
addedRemoved = foldr fn ([],[])
  where
    fn (ADD a) (as,rs) = (a:as,rs)
    fn (DEL r) (as,rs) = (as,r:rs)
    fn _       acc     = acc

addedConflictRemoved :: [Edit4 a] -> ([a],[(a,a)],[a])
addedConflictRemoved = foldr fn ([],[],[])
  where
    fn (ADD a)   (as,cs,rs) = (a:as,cs,rs)
    fn (DIF a b) (as,cs,rs) = (as,(a,b):cs,rs)
    fn (DEL r)   (as,cs,rs) = (as,cs,r:rs)
    fn _         acc        = acc


conflictRemoved :: [Edit4 a] -> ([(a,a)],[a])
conflictRemoved = foldr fn ([],[])
  where
    fn (DIF a b)   (cs,rs) = ((a,b):cs,rs)
    fn (DEL r)     (cs,rs) = (cs,r:rs)
    fn _           acc     = acc