[Utilitaire] Compteur de lignes

import System.Posix.Files
import System.Directory
import System.IO
import System.Environment
import System.FilePath.Glob
import Debug.Trace

directory   ""    =  return []
directory   dir   =  do filename <- b
                        valid    <- c
                        return (zip filename valid)
                      where
                             a = getDirectoryContents dir >>=
                                 return . filter (\\x -> x /= "." && x /= "..")
                             b = a                                                   >>=
                                 mapM      (return.((dir++"/")++))
                             c = b                                                   >>=
                                 mapM      (\\x -> getFileStatus x)                   >>=
                                 mapM      (return . isDirectory)

exclude _          [] = False
exclude []          s = True
exclude (f:filtres) s = if not $ match (compile f) s
                        then exclude filtres s
                        else False

file name = do putStr (name)
               handle  <- openFile name ReadMode
               content <- hGetContents  handle
               nbln    <- (return . length . lines) content
               putStrLn (" ... "++show(nbln))
               hClose handle
               return nbln

decision ex (a,False)  = if not $ exclude ex a then return 0 else file a
decision ex (a,True)   = directory a >>= mapM (decisionAcc ex 0) >>= return . sum

decisionAcc ex acc param = decision ex param >>= (\\x -> return (acc+x))

exec = do cdir  <- getCurrentDirectory
          liste <- directory cdir
          excl  <- getArgs
          res   <- mapM (decisionAcc excl 0) liste
          putStr "Total : "
          putStrLn $ (show . sum) res

{- execdbg x = do cdir  <- getCurrentDirectory
               liste <- directory cdir
               excl  <- return x
               res   <- mapM (decisionAcc excl 0) liste
               putStr "Total : "
               putStrLn $ (show) res -}

main = exec

import Control.Monad
import Control.Monad.Trans
import Control.Monad.List
import Control.Monad.State

import System.Directory
import System.Environment
import System.IO
import System.Posix.Files

directory :: FilePath -> ListT (StateT Int IO) FilePath
directory   ""    =  mzero
directory   dir   =  do file <- ListT $ lift $ getDirectoryContents dir
                        guard $ not_point file
                        return $ dir ++ "/" ++ file
  where
    not_point "."  = False
    not_point ".." = False
    not_point  _   = True


linesOfFile :: String -> IO Int
linesOfFile name = do contents <- openBinaryFile name ReadMode >>= hGetContents
                      return $ length $ lines contents


printNbLines :: String -> IO Int
printNbLines fp = do putStr fp
                     n <- linesOfFile fp
                     putStrLn (" ... " ++ (show n))
                     return n


decision :: FilePath -> ListT (StateT Int IO) ()
decision fp = do status <- lift $ liftIO $ getFileStatus fp
                 if isDirectory status
                  then do file <- directory fp
                          decision file
                  else if isRegularFile status
                        then do n <- lift $ liftIO $ printNbLines fp
                                lift $ modify (+n)
                        else lift$ liftIO $ putStrLn (fp ++ " ... Not a regular file")




run :: FilePath -> IO ()
run fp = do putStrLn ("\\nEntering " ++ fp)
            (_,i) <- runStateT (runListT $ decision fp) 0
            putStrLn ("\\nTotal of " ++ fp ++ " : " ++ (show i))


main :: IO ()
main = do args <- getArgs
          mapM run args
          return ()

rem line counter
startsf
set window on
set display mode 800,600,32
set text font "courier"
set text size 22
set text to bold


rem introduction message
print "------ Line Counter ------"
print "Coded in  2010  by Darktib"
print "--------------------------"
print ""


rem global variables
global dim extensions(0) as string
global nbExtensions as integer
global lineCount as integer
global emptyLineCount as integer
global foundFiles as integer
global filesearched as integer
global dirsearched as integer
global patherror as integer
patherror=0
filesearched=0
dirsearched=0
lineCount = 0
emptyLineCount = 0
nbExtensions = 0
foundFiles=0


rem types
type FOLDER
   path as string
   name as string
endtype


rem fill extensions
res$=""
repeat
   print ""
   print "Input an extension WITHOUT the dot; enter"
   print "a dot to finish extension input ; do not"
   print "enter backspace or special characters ."
   input "Extension: ",res$
   if res$ <> "."
      array insert at bottom extensions(0)
      extensions(nbExtensions) = res$
      inc nbExtensions
   endif
until res$ = "."


rem start counting lines
cls
recurseFolder(get dir$())


rem search synopsis
print ""
print "-------------------------------------------------------"
print "The has been limited to the specified extensions:"
exts$=""
for t = 0 to nbExtensions
    if extensions(t)<>"" then exts$ = exts$ + extensions(t) + ";"
next t
print exts$


rem results
print ""
print "-------------------------------------------------------"
print "Search result:"
print "Search in " + str$(dirsearched) + " subfolders for " + str$(filesearched) + " files (" + str$(patherror) + " path error)"
print "Files found: ";foundFiles
print "Total lines: ";lineCount
print "Hit a key to exit"

wait key
end


rem -------- FUNCTIONS -----------
function recurseFolder(dir$)
   set dir dir$

   local dim folders(0) as FOLDER

   find first

   while get file type()<>-1
      if get file type() = 1
         array insert at bottom folders(0)
         folders(array count(folders(0))-1).path = dir$ + "\\" + get file name$()
         folders(array count(folders(0))-1).name = get file name$()
      endif

      if get file type() = 0 then filesearched = filesearched + 1

      if get file type() = 0 and canCount(get file name$())
         foundFiles = foundFiles + 1
         countLines(get file name$())
      endif

      find next

      cls
      print filesearched;" files..."
   endwhile

   for t = 0 to array count(folders(0))-1
      if folders(t).name <> "." and folders(t).name <> ".."
         if path exist(folders(t).path)=1
            dirsearched = dirsearched + 1
            recurseFolder(folders(t).path)
         else
            dirsearched = dirsearched + 1
            patherror = patherror + 1
         endif
      endif
   next t
endfunction

function countLines(filename$)
remstart    SLOW METHOD
   open to read 1,filename$

   last$=""
   readBytes=0
   while file end(1)=0
      read byte 1,octet
      inc readBytes
      if octet = 13
         inc lineCount
         if last$ = "" then inc emptyLineCount
         last$=""
      else
         last$ = last$ + chr$(octet)
      endif
   endwhile
   if readBytes=0
      inc lineCount
      inc emptyLineCount
   else
      inc lineCount
   endif

   close file 1
remend
   readfilef filename$,1
   lineCount = lineCount + linesf(1)
   closef 1

endfunction
function canCount(filename$)
   res = 0
   ext$ = getExtension$(filename$)
   for t = 0 to nbExtensions
      if extensions(t) = ext$ then res = 1
   next t
endfunction res
function sub$( substr$, start, length )
   if length = -1
      res$ = right$(substr$,len(substr$)-start)
   else
      res$ = left$(right$(substr$,len(substr$)-start), length)
   endif
endfunction res$
function indexOf( substr$, iOf$ )
   res = -1
   ok = 0
   for t = 0 to len(substr$)
      if sub$(substr$,t,len(iOf$)) = iOf$ and ok = 0
         ok = 1
         res = t
      endif
   next t
endfunction res
function lastIndexOf( substr$, iOf$ )
   res = -1
   for t = 0 to len(substr$)
      if sub$(substr$,t,len(iOf$)) = iOf$ then res = t
   next t
endfunction res
function getExtension$( filename$ )
   rem remove the path
   res_str$ = sub$(filename$,lastIndexOf(filename$,"\\")+1,-1)

   rem retrieve the last extension without the dot
   res_str$ = sub$(res_str$,lastIndexOf(res_str$,".")+1,-1)

endfunction res_str$