Watcher.hs

module Tricorder.Watcher
    ( component
    , WatchedFile (..)
    , isCabalFile
    , markWatchedFiles
    ) where

import Atelier.Component (Component (..), defaultComponent)
import Atelier.Effects.Chan (Chan)
import Atelier.Effects.Conc (Conc)
import Atelier.Effects.Debounce (Debounce)
import Atelier.Effects.FileWatcher
    ( FileEvent
    , FileWatcher
    , Watch
    , containing
    , dirExt
    , dirWhere
    , excluding
    , watchFilePathsDebounced
    )
import Atelier.Effects.Publishing (Pub, Sub, publish)
import Effectful.Concurrent (Concurrent)
import Effectful.Reader.Static (Reader, ask)
import System.FilePath (takeExtension, takeFileName)

import Atelier.Effects.Publishing qualified as Sub

import Tricorder.BuildState
    ( CabalChangeDetected (..)
    , ChangeKind (..)
    , SourceChangeDetected (..)
    )
import Tricorder.Effects.BuildStore (BuildStore)
import Tricorder.Effects.SessionStore (SessionStore, SessionStoreReloaded)
import Tricorder.Runtime (ProjectRoot (..))
import Tricorder.Session (Session (..))

import Tricorder.Effects.BuildStore qualified as BuildStore
import Tricorder.Effects.SessionStore qualified as SessionStore


-- | Watcher component.
-- Watches source files and cabal-related files for changes, setting the dirty
-- flag in 'BuildStore'. 'GhciSession' polls this flag and triggers a rebuild
-- or session restart accordingly.
component
    :: ( BuildStore :> es
       , Chan :> es
       , Conc :> es
       , Concurrent :> es
       , Debounce FilePath :> es
       , FileWatcher :> es
       , Pub CabalChangeDetected :> es
       , Pub SourceChangeDetected :> es
       , Pub WatchedFile :> es
       , Reader ProjectRoot :> es
       , SessionStore :> es
       , Sub SessionStoreReloaded :> es
       , Sub WatchedFile :> es
       )
    => Component es
component =
    defaultComponent
        { name = "Watcher"
        , triggers = pure [watchFiles]
        , listeners = pure [Sub.listen_ markWatchedFiles]
        }


markWatchedFiles
    :: ( BuildStore :> es
       , Pub CabalChangeDetected :> es
       , Pub SourceChangeDetected :> es
       )
    => WatchedFile -> Eff es ()
markWatchedFiles f = do
    BuildStore.markDirty change
    case change of
        CabalChange -> publish (CabalChangeDetected f.path f.event)
        SourceChange -> publish (SourceChangeDetected f.path f.event)
  where
    change = changeKindFor f.path


data WatchedFile = WatchedFile
    { path :: FilePath
    , event :: FileEvent
    }


data WatcherSession = WatcherSession
    { watchDirs :: [FilePath]
    }
    deriving stock (Eq)


withWatcherSession
    :: ( Chan :> es
       , Conc :> es
       , Concurrent :> es
       , SessionStore :> es
       , Sub SessionStoreReloaded :> es
       )
    => Session
    -> (SessionStore.Reloader es -> WatcherSession -> Eff es Void)
    -> Eff es Void
withWatcherSession =
    SessionStore.withSubSession $ WatcherSession . (.watchDirs)


watchFiles
    :: ( Chan :> es
       , Conc :> es
       , Concurrent :> es
       , Debounce FilePath :> es
       , FileWatcher :> es
       , Pub WatchedFile :> es
       , Reader ProjectRoot :> es
       , SessionStore :> es
       , Sub SessionStoreReloaded :> es
       )
    => Eff es Void
watchFiles = do
    initialSession <- SessionStore.get
    withWatcherSession initialSession $ \_ session -> do
        projectRoot <- ask
        let watches = sourceWatches session.watchDirs <> cabalWatches projectRoot
        watchFilePathsDebounced watches \filePath fileEvent -> publish (WatchedFile filePath fileEvent)


sourceWatches :: [FilePath] -> [Watch]
sourceWatches = map (\d -> dirExt d ".hs" `excluding` containing "dist-newstyle")


cabalWatches :: ProjectRoot -> [Watch]
cabalWatches (ProjectRoot projectRoot) =
    [dirWhere projectRoot isCabalFile `excluding` containing "dist-newstyle"]


isCabalFile :: FilePath -> Bool
isCabalFile f =
    takeExtension f == ".cabal"
        || takeFileName f `elem` ["cabal.project", "package.yaml"]


changeKindFor :: FilePath -> ChangeKind
changeKindFor path
    | isCabalFile path = CabalChange
    | otherwise = SourceChange