-- GetFNamesBckp.hs

module GetFNamesBckp where

import Directory
import List

import Foreign
import Foreign.C

foreign export ccall getFNamesToZipC :: Int -> (Ptr CString) -> IO (Ptr CString)

----------------------------------------------------------------------------
-- Function getFNamesToZip
----------------------------------------------------------------------------
getFNamesToZipC :: Int -> (Ptr CString) -> IO (Ptr CString)
getFNamesToZipC nLen vFs 
  = do cfs <- peekArray nLen vFs
       hfs <- peekCStringArr cfs
       hzs <- getFNamesToZip hfs
       czs <- createCStringArr hzs
       vZs <- newArray czs
       return vZs
       where
       peekCStringArr :: [CString] -> IO [String]
       peekCStringArr [] = return []
       peekCStringArr (cf:cfs) = do hf <- peekCString cf
                                    hfs <- peekCStringArr cfs
                                    return (hf : hfs)
       createCStringArr :: [String] -> IO [CString]
       createCStringArr [] = do sentinel <- newCString "//"
                                return [sentinel]
       createCStringArr (hf:hfs) = do cf <- newCString hf
                                      cfs <- createCStringArr hfs
                                      return (cf : cfs)

getFNamesToZip :: [FilePath] -> IO [FilePath]
getFNamesToZip (f:fs) 
  = do isAFile <- doesFileExist f
       isADir <- doesDirectoryExist f
       if (isAFile)
         then do ll <- getFNamesToZip fs
                 if (isFileToZip f) then return ([f] ++ ll) else return ll
         else if (isADir) && (isDirToZip f)
           then do subdir <- getDirectoryContents f
                   let subfs = [joinDirSubDir f sf | sf <- subdir, sf /= ".", sf /= ".."]
                   l1 <- getFNamesToZip subfs
                   l2 <- getFNamesToZip fs
                   return (l1 ++ l2)
           else getFNamesToZip fs
getFNamesToZip [] = return []

joinDirSubDir :: FilePath -> FilePath -> FilePath
joinDirSubDir d sd
  | (last d) == '/' = d ++ sd
  | otherwise       = (d ++ "/") ++ sd
                            
----------------------------------------------------------------------------
-- Function globFilePattern
----------------------------------------------------------------------------
globFilePattern :: String -> String -> Bool
globFilePattern [] ('*':csPattern) = globFilePattern [] csPattern
globFilePattern [] [] = True
globFilePattern (_:_) [] = False
globFilePattern [] (_:_) = False
globFilePattern (cToMatch:csToMatch) ('*':csPattern)
  | globFilePattern csToMatch csPattern = True
  | otherwise                   = globFilePattern csToMatch ('*':csPattern)
globFilePattern (cToMatch:csToMatch) (cPattern:csPattern)
  | cToMatch == cPattern        = globFilePattern csToMatch csPattern
  | otherwise                   = False

----------------------------------------------------------------------------
-- Function globFilePatternV
----------------------------------------------------------------------------
globFilePatternV :: String -> [String] -> Bool
globFilePatternV csToMatch [] = False
globFilePatternV csToMatch (p:ps)
  | globFilePattern csToMatch p = True
  | otherwise                   = globFilePatternV csToMatch ps

----------------------------------------------------------------------------
-- Function isFileToZip and isDirToZip
----------------------------------------------------------------------------
isFileToZip :: FilePath -> Bool
isFileToZip f =  isFileToZipAI f getAddRegVec getIgnRegVec

isFileToZipAI :: FilePath -> [FilePath] -> [FilePath] -> Bool
isFileToZipAI f vAdd vIgn = (globFilePatternV f vAdd) && not (globFilePatternV f vIgn)
  
isDirToZip :: FilePath -> Bool
isDirToZip f = isFileToZipAI f (getAddRegVec ++ (getBaseDirVR getAddRegVec)) (getIgnRegVec)

getBaseDir :: FilePath -> FilePath 
getBaseDir "/" = []
getBaseDir f = (rev . getFromSlash . rev) f
  where rev :: FilePath -> FilePath
        rev [] = []
        rev (c:cs) = (rev cs) ++ [c]
        getFromSlash :: FilePath -> FilePath
        getFromSlash [] = []
        getFromSlash "/" = "/"
        getFromSlash ('/':cs) = cs
        getFromSlash (_:cs) = getFromSlash cs

getBaseDirR :: FilePath -> [FilePath]
getBaseDirR [] = []
getBaseDirR f = getBaseDirR(getBaseDir f) ++ [getBaseDir f]

getBaseDirV :: [FilePath] -> [FilePath]
getBaseDirV = elimDup . map getBaseDir

getBaseDirVR :: [FilePath] -> [FilePath]
getBaseDirVR = elimEmp . elimDup . foldr (++) [] . map getBaseDirR
               where elimEmp :: [FilePath] -> [FilePath]
                     elimEmp [] = []
                     elimEmp ("":fs) = elimEmp fs
                     elimEmp fs = fs

elimDup :: Ord a => [a] -> [a]
elimDup = foldr (++) [] .  map (take 1) . group . sort

----------------------------------------------------------------------------
-- Functions getAddRegVec and getIgnRegVec
----------------------------------------------------------------------------
getAddRegVec :: [String]
getAddRegVec
  =  ["/home/francis/francis_cal.*",
      "/home/francis/francis_cal.vcs",
      "/home/francis/Mail/*",
      "/home/francis/.aspell.fr.*",
      "/home/francis/.bash_history",
      "/home/francis/.lyx/*",
      "/home/francis/.bash_logout",
      "/home/francis/.bash_profile",
      "/home/francis/.bashrc",
      "/home/francis/.jedit/*",
      "/home/francis/.menu/*",
      "/home/francis/.xemacs/*",
      "/home/francis/PERSONNEL/*"]

getIgnRegVec :: [String]
getIgnRegVec 
  =  ["*.o",
      "*.so",
      "*.a",
      "*.hi",
      "*.pyc",
      "*/FT-BOULOT*",
      "*~"]