{-# OPTIONS_GHC -Wall #-}
module Main where

import           ALON.Diff.HTML (diffHTMLWithPatchRefs, DiffWithPatchRefs(..), DiffToken)
import qualified Data.Text as T
import           Data.Text.Lazy (toStrict, replace, pack, unpack)
import           Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Aeson as DA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import           System.IO (hPutStrLn, stderr)
import           System.IO.Error (IOError,isDoesNotExistError)
import           System.Exit (exitFailure, exitSuccess)
import           Control.Exception (catch)
import           System.Environment (getArgs)
import           System.Directory (copyFile, removeDirectoryRecursive, createDirectory)
import           System.FilePath (takeDirectory, replaceFileName, takeFileName, combine)
import           System.FSNotify(withManager, watchTree, Event( Modified ), WatchManager )
import           Data.Atomics.Counter
import           Control.Concurrent.Lock as LK
import qualified Data.ByteString.Base16 as B16
import qualified Data.List as DL

readUTF8File :: String -> IO T.Text
readUTF8File filePath = 
    L.readFile filePath `catch` errorHandler >>= return . toStrict . decodeUtf8
    where
    errorHandler e =
        let _ = (e :: IOError) in 
            hPutStrLn stderr ("Error opening HTML file " ++ filePath) >> exitFailure

copyNormalize :: String -> String -> IO ()
copyNormalize inputFile outputFile = do
    inputData <- L.readFile inputFile
    let inputText = decodeUtf8 inputData
    let normalizeLineFeed = replace (pack "\r")  (pack "\n") $ replace (pack "\r\n") (pack "\n") inputText
    L.writeFile outputFile $ encodeUtf8 normalizeLineFeed

deltaFiles :: String -> String -> IO (Maybe DiffWithPatchRefs)
deltaFiles sourceHtmlFile targetHtmlFile = do
    sourceHtml <- readUTF8File sourceHtmlFile
    targetHtml <- readUTF8File targetHtmlFile

    if T.length targetHtml > 0 then 
        return $ diffHTMLWithPatchRefs sourceHtml targetHtml
    else do
        putStrLn "Not building delta, target file is empty, probably due to file race."
        return Nothing

writePatchRef :: String -> (B.ByteString, Maybe [DiffToken]) -> IO ()
writePatchRef targetFile (patchHash, Just patchTokens) = do
    let hexHash    = unpack $ decodeUtf8 $ L.fromStrict $ B16.encode patchHash    
    let outputFile = replaceFileName targetFile (hexHash ++ ".json") 
    let jsonBytes  = DA.encode patchTokens
    L.writeFile outputFile jsonBytes
writePatchRef _          _                             = return ()

watchSink :: String -> String -> String -> WatchManager -> IO ()
watchSink watchedFile patchDirectory sourceFile manager = do
    let watchedDirectory = takeDirectory watchedFile
    counter <- newCounter 0
    lock <- LK.new
    let 
      watchAction (Modified path _ False) = do
          LK.acquire lock
          
          copyNormalize path targetFile
          delta <- deltaFiles sourceFile targetFile

          case delta of 
            (Just (DiffWithPatchRefs diff patchRefs)) -> do
                currentCount <- incrCounter 1 counter
                let outputFile = replaceFileName targetFile ( "patch-" ++ show currentCount ++ ".json" )
                let jsonBytes = DA.encode diff
                DL.foldl' (\io patchRef -> io >> writePatchRef targetFile patchRef) (return ()) patchRefs
                L.writeFile outputFile jsonBytes
                copyFile targetFile sourceFile
                putStr "Updated " 
                putStr path
                putStr " to patch "
                putStrLn outputFile
            Nothing                                   -> putStrLn "Couldn't build delta patch, probably due to malformed HTML."

          LK.release lock

      watchAction _                   = return ()

    stopListening <- watchTree manager watchedDirectory watchPredicate watchAction
    _ <- getLine
    stopListening
    exitSuccess
  where
    targetFile      = combine patchDirectory "delta_target.html"
    watchedFileName = takeFileName watchedFile
    watchPredicate (Modified path _ _) = takeFileName path == watchedFileName
    watchPredicate _                   = False 

watchAndPatchFile :: String -> String -> IO ()
watchAndPatchFile watchedFile patchDirectory = do
    removeDirectoryRecursive patchDirectory `catch` removePatchesHandler
    createDirectory patchDirectory
    let baseFile = replaceFileName watchedFile "base.html"
    let sourceFile = combine patchDirectory "delta_source.html"
    copyNormalize watchedFile baseFile
    copyFile baseFile sourceFile
    putStrLn "Watching file, press RETURN to exit"
    withManager (watchSink watchedFile patchDirectory sourceFile)
  where 
    removePatchesHandler e | isDoesNotExistError e = return ()
                           | otherwise             = print e >> exitFailure

main :: IO ()
main = do 
    args <- getArgs
    
    case args of
        (watchedFile:_) -> 
            let targetDirectory = combine (takeDirectory watchedFile) "patches" in
            watchAndPatchFile watchedFile targetDirectory
        _               -> hPutStrLn stderr "Expects 1 command line parameter" >> exitFailure