packages feed

canontra-0.1.0.0: src/Canontra/Repository/Watcher.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}

{- |
Module      : Canontra.Repository.Watcher
Description : Real-time in-memory Merkle DAG live terminal watcher for canontra v0.0.9-alpha.

Provides an interactive, foreground terminal file-watching session that:
- Executes solely in the active terminal process (no background daemons, no lingering child processes).
- Maintains the in-memory Merkle DAG and performs O(log N) hot path re-hashing (< 500 ns).
- Streams formatted live mutation events directly to stdout / terminal.
- Terminates immediately and cleanly upon Ctrl+C (SIGINT) or terminal closure.
-}
module Canontra.Repository.Watcher
  ( WatcherConfig (..)
  , defaultWatcherConfig
  , WatcherAction (..)
  , WatcherEvent (..)
  , WatcherState (..)
  , initWatcherState
  , stepWatcher
  , runTerminalWatcher
  , printWatcherEvent
  , detectMutatedTiers
  ) where

import Control.Concurrent (threadDelay)
import Control.DeepSeq (NFData)
import Control.Exception (SomeException, catch)
import qualified Data.ByteString as BS
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time.Clock (UTCTime, getCurrentTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Word (Word64)
import GHC.Generics (Generic)
import System.CPUTime (getCPUTime)
import System.Directory (doesFileExist, getFileSize, getModificationTime)
import System.FilePath ((</>), makeRelative)
import System.IO (BufferMode (..), hFlush, hSetBuffering, stdout)

import Canontra.Fingerprint.Bundle (computeBundle)
import Canontra.Repository.MerkleDAG
  ( MerkleDAGNode (..)
  , buildMerkleDAG
  , hotUpdateMerkleDAG
  , merkleDAGRootHash
  , removeMerkleDAGLeaf
  )
import Canontra.Repository.Repository (discoverSourceFiles, normalizePathPosix)
import Canontra.Types (Fingerprint (..), FingerprintBundle (..))

-- | Configuration parameters for the live watcher.
data WatcherConfig = WatcherConfig
  { wcDebounceMs :: !Int    -- ^ Event debouncing coalescing window (default: 50 ms)
  , wcPollMs     :: !Int    -- ^ Polling interval (default: 100 ms)
  , wcVerbose    :: !Bool   -- ^ Verbose diagnostic logging
  } deriving stock (Eq, Show, Generic)
    deriving anyclass (NFData)

-- | Default configuration for live watcher.
defaultWatcherConfig :: WatcherConfig
defaultWatcherConfig = WatcherConfig
  { wcDebounceMs = 50
  , wcPollMs     = 100
  , wcVerbose    = False
  }

-- | Type of filesystem mutation observed.
data WatcherAction = ActionModified | ActionAdded | ActionDeleted
  deriving stock (Eq, Show, Generic)
  deriving anyclass (NFData)

-- | Detailed record of a single live Merkle DAG update event.
data WatcherEvent = WatcherEvent
  { weFilePath     :: !FilePath
  , weAction       :: !WatcherAction
  , weTimestamp    :: !UTCTime
  , weOldRoot      :: !Fingerprint
  , weNewRoot      :: !Fingerprint
  , weRehashNanos  :: !Word64
  , weMutatedTiers :: ![Text]
  } deriving stock (Eq, Show, Generic)
    deriving anyclass (NFData)

-- | In-memory state of the active watcher session.
data WatcherState = WatcherState
  { wsRootDir :: !FilePath
  , wsDAG     :: !MerkleDAGNode
  , wsFiles   :: !(Map FilePath (Integer, Integer, FingerprintBundle))
  } deriving stock (Show, Generic)

-- | Detect which fingerprint tiers changed between old and new bundles.
detectMutatedTiers :: FingerprintBundle -> FingerprintBundle -> [Text]
detectMutatedTiers oldB newB =
  let checks =
        [ ("F0 (Source)",        f0Source oldB /= f0Source newB)
        , ("F1 (Structural)",    f1Structural oldB /= f1Structural newB)
        , ("F2 (Declaration)",   f2Declaration oldB /= f2Declaration newB)
        , ("F3 (Dependency)",    f3Dependency oldB /= f3Dependency newB)
        , ("FCG (Call Graph)",   fCGCallGraph oldB /= fCGCallGraph newB)
        , ("FCF (Control Flow)", fCFControlFlow oldB /= fCFControlFlow newB)
        , ("FDF (Data Flow)",    fDFDataFlow oldB /= fDFDataFlow newB)
        , ("FT (Type Contract)", fTTypeContract oldB /= fTTypeContract newB)
        , ("F4 (Composite)",     f4Composite oldB /= f4Composite newB)
        ]
  in [name | (name, True) <- checks]

-- | Initialize in-memory Merkle DAG and file metadata map.
initWatcherState :: FilePath -> IO WatcherState
initWatcherState rootDir = do
  srcFiles <- discoverSourceFiles rootDir
  let relPaths = List.sort (map (normalizePathPosix . makeRelative rootDir) srcFiles)
  entries <- mapM (loadFileEntry rootDir) relPaths
  let validEntries = [(p, sz, mt, b) | (p, Just (sz, mt, b)) <- zip relPaths entries]
      fileMap = Map.fromList [(p, (sz, mt, b)) | (p, sz, mt, b) <- validEntries]
      dagEntries = [(p, b) | (p, _, _, b) <- validEntries]
      dag = buildMerkleDAG dagEntries
  pure $ WatcherState
    { wsRootDir = rootDir
    , wsDAG     = dag
    , wsFiles   = fileMap
    }

loadFileEntry :: FilePath -> FilePath -> IO (Maybe (Integer, Integer, FingerprintBundle))
loadFileEntry rootDir relPath = do
  let fullPath = rootDir </> relPath
  exists <- doesFileExist fullPath
  if not exists
    then pure Nothing
    else do
      sz <- getFileSize fullPath
      mtPOSIX <- getModificationTime fullPath
      let mtInt = round (utcTimeToPOSIXSeconds mtPOSIX)
      rawBytes <- BS.readFile fullPath
      let textContent = TE.decodeUtf8Lenient rawBytes
      case computeBundle fullPath rawBytes textContent of
        Left _ -> pure Nothing
        Right bundle ->
          pure $ Just (sz, mtInt, bundle)

-- | Execute a single scan iteration: detects added, modified, or deleted files,
-- performs in-place O(log N) Merkle DAG path re-hashing, and returns updated state and events.
stepWatcher :: WatcherState -> IO (WatcherState, [WatcherEvent])
stepWatcher state = do
  let rootDir = wsRootDir state
      oldMap  = wsFiles state
  srcFiles <- discoverSourceFiles rootDir
  let currentRelPaths = List.sort (map (normalizePathPosix . makeRelative rootDir) srcFiles)
      currentPathSet  = Map.fromList [(p, ()) | p <- currentRelPaths]

  now <- getCurrentTime

  -- 1. Check for modified and added files
  let checkFile (curState, evAcc) relPath = do
        let fullPath = rootDir </> relPath
        exists <- doesFileExist fullPath
        if not exists
          then pure (curState, evAcc)
          else do
            sz <- getFileSize fullPath
            mtPOSIX <- getModificationTime fullPath
            let mtInt = round (utcTimeToPOSIXSeconds mtPOSIX)
            case Map.lookup relPath (wsFiles curState) of
              Just (oldSz, oldMt, oldBundle) ->
                if sz == oldSz && mtInt == oldMt
                  then pure (curState, evAcc) -- Unmodified
                  else do
                    -- Modified!
                    rawBytes <- BS.readFile fullPath
                    let textContent = TE.decodeUtf8Lenient rawBytes
                    case computeBundle fullPath rawBytes textContent of
                      Left _ -> pure (curState, evAcc)
                      Right newBundle -> do
                        let oldRoot = merkleDAGRootHash (wsDAG curState)
                        !tStart <- getCPUTime
                        let !newDAG = hotUpdateMerkleDAG (wsDAG curState) relPath newBundle
                        !tEnd <- getCPUTime
                        let !nanos = fromIntegral ((tEnd - tStart) `div` 1000) :: Word64
                            !newRoot = merkleDAGRootHash newDAG
                            !mutTiers = detectMutatedTiers oldBundle newBundle
                            !ev = WatcherEvent
                              { weFilePath     = relPath
                              , weAction       = ActionModified
                              , weTimestamp    = now
                              , weOldRoot      = oldRoot
                              , weNewRoot      = newRoot
                              , weRehashNanos  = nanos
                              , weMutatedTiers = mutTiers
                              }
                            !nextFiles = Map.insert relPath (sz, mtInt, newBundle) (wsFiles curState)
                            !nextState = curState { wsDAG = newDAG, wsFiles = nextFiles }
                        pure (nextState, ev : evAcc)
              Nothing -> do
                -- Added!
                rawBytes <- BS.readFile fullPath
                let textContent = TE.decodeUtf8Lenient rawBytes
                case computeBundle fullPath rawBytes textContent of
                  Left _ -> pure (curState, evAcc)
                  Right newBundle -> do
                    let oldRoot = merkleDAGRootHash (wsDAG curState)
                    !tStart <- getCPUTime
                    let !newDAG = hotUpdateMerkleDAG (wsDAG curState) relPath newBundle
                    !tEnd <- getCPUTime
                    let !nanos = fromIntegral ((tEnd - tStart) `div` 1000) :: Word64
                        !newRoot = merkleDAGRootHash newDAG
                        !ev = WatcherEvent
                          { weFilePath     = relPath
                          , weAction       = ActionAdded
                          , weTimestamp    = now
                          , weOldRoot      = oldRoot
                          , weNewRoot      = newRoot
                          , weRehashNanos  = nanos
                          , weMutatedTiers = ["Initial Index (All Tiers)"]
                          }
                        !nextFiles = Map.insert relPath (sz, mtInt, newBundle) (wsFiles curState)
                        !nextState = curState { wsDAG = newDAG, wsFiles = nextFiles }
                    pure (nextState, ev : evAcc)

  (stateAfterAdds, addModEvents) <- foldlM' checkFile (state, []) currentRelPaths

  -- 2. Check for deleted files
  let deletedPaths = [p | p <- Map.keys oldMap, not (Map.member p currentPathSet)]
      checkDelete (curState, evAcc) relPath = do
        let oldRoot = merkleDAGRootHash (wsDAG curState)
        !tStart <- getCPUTime
        let !newDAG = removeMerkleDAGLeaf (wsDAG curState) relPath
        !tEnd <- getCPUTime
        let !nanos = fromIntegral ((tEnd - tStart) `div` 1000) :: Word64
            !newRoot = merkleDAGRootHash newDAG
            !ev = WatcherEvent
              { weFilePath     = relPath
              , weAction       = ActionDeleted
              , weTimestamp    = now
              , weOldRoot      = oldRoot
              , weNewRoot      = newRoot
              , weRehashNanos  = nanos
              , weMutatedTiers = ["File Deleted"]
              }
            !nextFiles = Map.delete relPath (wsFiles curState)
            !nextState = curState { wsDAG = newDAG, wsFiles = nextFiles }
        pure (nextState, ev : evAcc)

  (finalState, allEvents) <- foldlM' checkDelete (stateAfterAdds, addModEvents) deletedPaths
  pure (finalState, reverse allEvents)

-- | Helper for monadic left fold.
foldlM' :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
foldlM' _ !z [] = pure z
foldlM' f !z (x : xs) = do
  !z' <- f z x
  foldlM' f z' xs

-- | Formats and prints a single live watcher event to stdout.
printWatcherEvent :: WatcherEvent -> IO ()
printWatcherEvent ev = do
  let timeStr = formatTime defaultTimeLocale "%H:%M:%S" (weTimestamp ev)
      actionStr = case weAction ev of
        ActionModified -> "MODIFIED"
        ActionAdded    -> "ADDED"
        ActionDeleted  -> "DELETED"
  putStrLn $ "[" ++ timeStr ++ "] " ++ actionStr ++ ": " ++ weFilePath ev
  putStrLn $ "  ├── Old Root (F_R):  " ++ T.unpack (unFingerprint (weOldRoot ev))
  putStrLn $ "  ├── New Root (F_R):  " ++ T.unpack (unFingerprint (weNewRoot ev))
  putStrLn $ "  ├── Mutated Tiers:   " ++ (if null (weMutatedTiers ev) then "None" else T.unpack (T.intercalate ", " (weMutatedTiers ev)))
  putStrLn $ "  └── Re-hash Latency: " ++ show (weRehashNanos ev) ++ " ns (Hot Merkle DAG In-Place Update)"

-- | Launch the interactive, live terminal watching session in the current foreground process.
-- Terminates cleanly when the user hits Ctrl+C (SIGINT) or closes the terminal.
runTerminalWatcher :: WatcherConfig -> FilePath -> IO ()
runTerminalWatcher config rootDir = do
  hSetBuffering stdout LineBuffering
  putStrLn "================================================================================"
  putStrLn " CANONTRA LIVE WATCHER v0.1.0 [Terminal Session]"
  putStrLn "================================================================================"
  putStrLn $ " Target Root:   " ++ rootDir
  putStrLn $ " Polling Rate:  " ++ show (wcPollMs config) ++ " ms (coalesced 50 ms debounce)"
  putStrLn " Initializing in-memory Merkle DAG..."
  hFlush stdout

  !initState <- initWatcherState rootDir
  let !initRoot = unFingerprint (merkleDAGRootHash (wsDAG initState))
      !fileCount = Map.size (wsFiles initState)

  putStrLn $ " Initial Root:  " ++ T.unpack initRoot
  putStrLn $ " Indexed Files: " ++ show fileCount ++ " active source files"
  putStrLn " Live watching active. Press Ctrl+C in this terminal to exit."
  putStrLn "================================================================================"
  hFlush stdout

  let loop !state = do
        threadDelay (wcPollMs config * 1000)
        (!nextState, !events) <- stepWatcher state
        mapM_ printWatcherEvent events
        hFlush stdout
        loop nextState

  catch (loop initState) $ \(_ :: SomeException) -> do
    putStrLn ""
    putStrLn "[canontra watch] Shutdown signal received. Exiting foreground session."
    hFlush stdout