Compare text

Find the difference between two text files

Real-time diff

Unified diff

Collapse lines

Highlight change

Syntax highlighting

Tools

Diffchecker Desktop The most secure way to run Diffchecker. Get the Diffchecker Desktop app: your diffs never leave your computer!Get Desktop

Untitled diff

Created 11 years agoDiff never expires

Lines
Total
Removed

Words
Total
Removed

To continue using this feature, upgrade to Diffchecker Pro View Pricing

80 lines

Lines
Total
Added

Words
Total
Added

To continue using this feature, upgrade to Diffchecker Pro View Pricing

120 lines

import Control.Concurrent

import Control.Concurrent.STM

import Control.Concurrent.STM.TVar

import Control.Monad

import System.Directory

import System.Environment (getArgs)

import System.Exit

import System.INotify

import System.IO

import System.Process

data Config =

Config

{ confCabalFile :: FilePath

{ confOutputFile :: FilePath

, confCabalFile :: FilePath

, confWorking :: Bool

} deriving (Show,Read)

main = do

args <- getArgs

let dir = head args

let cabalOutput = args !! 1

putStrLn $ "Watching directory: " ++ dir

putStrLn $ "Cabal output file: " ++ cabalOutput

contents <- getDirectoryContents dir

let contents' = filter filterCabal contents

case contents' of

(x:_) -> runThread x dir

(x:_) -> do

let config = Config cabalOutput x False

runThread config dir

[] -> do

putStrLn "No cabal file found!"

putStrLn "Exiting"

runThread cabal dir = do

runThread config dir = do

config <- newTVarIO $ Config cabal False

config <- newTVarIO config

n <- initINotify

putStrLn "Press <Enter> to exit"

print n

wd <- addWatch n

[ Modify, CloseWrite, Create, Delete, MoveIn, MoveOut ]

dir

(eventHandler config)

print wd

getLine

removeWatch wd

killINotify n

eventHandler :: TVar Config -> Event -> IO ()

eventHandler conf x@(Modified _ (Just fp)) = handleFilteredFile conf x fp

eventHandler conf x@(MovedIn _ fp _) = handleFilteredFile conf x fp

eventHandler conf x@(MovedOut _ fp _) = handleFilteredFile conf x fp

eventHandler conf x@(Created _ fp) = handleFilteredFile conf x fp

eventHandler conf x@(Deleted _ fp) = handleFilteredFile conf x fp

eventHandler _ _ = return ()

handleFilteredFile conf evt fp = do

handleFilteredFile conf evt fp =

if filterHS fp

when (filterHS fp) $ print evt >> doWork conf

then print evt >> doWork conf fp

else return ()

filterHS fp = fileExt fp == "hs"

filterCabal fp = fileExt fp == "cabal"

fileExt = reverse

. takeWhile (/= '.')

. reverse

doWork :: TVar Config -> FilePath -> IO ()

doWork :: TVar Config -> IO ()

doWork conf fp = do

doWork conf = do

config <- readTVarIO conf

if confWorking config

then do

print "Already working!"

return ()

else do

print "New work available!"

atomically $ writeTVar conf (config { confWorking = True })

_ <- forkIO $ runCI conf

return ()

runCI :: TVar Config -> IO ()

runCI conf = do

runCIChain conf

config <- readTVarIO conf

atomically $ writeTVar conf (config { confWorking = False })

return ()

runCIChain :: TVar Config -> IO ()

runCIChain conf = do

cabalBuild <- runCabal conf ["build"]

print $ "*** cabal build result: " ++ show cabalBuild

case cabalBuild of

False -> return ()

True -> do

cabalTest <- runCabal conf ["test"]

print $ "*** cabal test result: " ++ show cabalTest

runCabal :: TVar Config -> [String] -> IO Bool

runCabal conf args = do

(code, out, err) <- readProcessWithExitCode "cabal" args ""

config <- readTVarIO conf

let outputFile = confOutputFile config

_ <- when (out /= []) $ appendFile outputFile out

_ <- when (err /= []) $ appendFile outputFile err

case code of

ExitSuccess -> return True

ExitFailure _ -> return False

Saved diffs

Original text

Open file

import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import System.Directory
import System.Environment (getArgs)
import System.INotify
import System.IO

data Config =
  Config
    { confCabalFile :: FilePath
    , confWorking :: Bool
    } deriving (Show,Read)

main = do
  args <- getArgs
  let dir = head args
  putStrLn $ "Watching directory: " ++ dir
  contents <- getDirectoryContents dir
  let contents' = filter filterCabal contents
  case contents' of
    (x:_) -> runThread x dir
    [] -> do
      putStrLn "No cabal file found!"
      putStrLn "Exiting"

runThread cabal dir = do
  config <- newTVarIO $ Config cabal False
  n <- initINotify
  putStrLn "Press <Enter> to exit"
  print n
  wd <- addWatch n
                 [ Modify, CloseWrite, Create, Delete, MoveIn, MoveOut ]
                 dir
                 (eventHandler config)
  print wd
  getLine
  removeWatch wd
  killINotify n

eventHandler :: TVar Config -> Event -> IO ()
eventHandler conf x@(Modified _ (Just fp)) = handleFilteredFile conf x fp
eventHandler conf x@(MovedIn _ fp _) = handleFilteredFile conf x fp
eventHandler conf x@(MovedOut _ fp _) = handleFilteredFile conf x fp
eventHandler conf x@(Created _ fp) = handleFilteredFile conf x fp
eventHandler conf x@(Deleted _ fp) = handleFilteredFile conf x fp
eventHandler _ _ = return ()

handleFilteredFile conf evt fp = do
  if filterHS fp
    then print evt >> doWork conf fp
    else return ()

filterHS fp = fileExt fp == "hs"
filterCabal fp = fileExt fp == "cabal"

fileExt = reverse
        . takeWhile (/= '.')
        . reverse

doWork :: TVar Config -> FilePath -> IO ()
doWork conf fp = do
  config <- readTVarIO conf
  if confWorking config
    then do
      print "Already working!"
      return ()
    else do
      print "New work available!"
      atomically $ writeTVar conf (config { confWorking = True })
      return ()

Changed text

Open file

import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Monad
import System.Directory
import System.Environment (getArgs)
import System.Exit
import System.INotify
import System.IO
import System.Process

data Config =
  Config
    { confOutputFile :: FilePath
    , confCabalFile :: FilePath
    , confWorking :: Bool
    } deriving (Show,Read)

main = do
  args <- getArgs
  let dir = head args
  let cabalOutput = args !! 1
  putStrLn $ "Watching directory: " ++ dir
  putStrLn $ "Cabal output file: " ++ cabalOutput
  contents <- getDirectoryContents dir
  let contents' = filter filterCabal contents
  case contents' of
    (x:_) -> do
      let config = Config cabalOutput x False
      runThread config dir
    [] -> do
      putStrLn "No cabal file found!"
      putStrLn "Exiting"

runThread config dir = do
  config <- newTVarIO config
  n <- initINotify
  putStrLn "Press <Enter> to exit"
  print n
  wd <- addWatch n
                 [ Modify, CloseWrite, Create, Delete, MoveIn, MoveOut ]
                 dir
                 (eventHandler config)
  print wd
  getLine
  removeWatch wd
  killINotify n

handleFilteredFile conf evt fp =
  when (filterHS fp) $ print evt >> doWork conf

filterHS fp = fileExt fp == "hs"
filterCabal fp = fileExt fp == "cabal"

fileExt = reverse
        . takeWhile (/= '.')
        . reverse

doWork :: TVar Config -> IO ()
doWork conf = do
  config <- readTVarIO conf
  if confWorking config
    then do
      print "Already working!"
      return ()
    else do
      print "New work available!"
      atomically $ writeTVar conf (config { confWorking = True })
      _ <- forkIO $ runCI conf
      return ()

runCI :: TVar Config -> IO ()
runCI conf = do
  runCIChain conf
  config <- readTVarIO conf
  atomically $ writeTVar conf (config { confWorking = False })
  return ()

runCIChain :: TVar Config -> IO ()
runCIChain conf = do
  cabalBuild <- runCabal conf ["build"]
  print $ "*** cabal build result: " ++ show cabalBuild
  case cabalBuild of
    False -> return ()
    True -> do
      cabalTest <- runCabal conf ["test"]
      print $ "*** cabal test result: " ++ show cabalTest

runCabal :: TVar Config -> [String] -> IO Bool
runCabal conf args = do
  (code, out, err) <- readProcessWithExitCode "cabal" args ""
  config <- readTVarIO conf
  let outputFile = confOutputFile config
  _ <- when (out /= []) $ appendFile outputFile out
  _ <- when (err /= []) $ appendFile outputFile err
  case code of
    ExitSuccess -> return True
    ExitFailure _ -> return False