module HsDev.Watcher (
	watchProject, watchModule, watchPackageDb, watchPackageDbStack,
	unwatchProject, unwatchModule, unwatchPackageDb,
	isSource, isCabal, isConf,

	module System.Directory.Watcher,
	module HsDev.Watcher.Types
	) where

import Control.Lens (view)
import System.FilePath (takeDirectory, takeExtension, (</>))

import System.Directory.Watcher hiding (Watcher)
import System.Directory.Paths
import HsDev.Project
import HsDev.Symbols
import HsDev.Watcher.Types
import HsDev.Util

-- | Watch for project sources changes
watchProject :: Watcher -> Project -> [String] -> IO ()
watchProject :: Watcher -> Project -> [String] -> IO ()
watchProject Watcher
w Project
proj [String]
opts = do
	(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
dir -> Watcher -> String -> (Event -> Bool) -> Watched -> IO ()
forall a. Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchTree Watcher
w String
dir Event -> Bool
isSource (Project -> [String] -> Watched
WatchedProject Project
proj [String]
opts)) [String]
dirs
	Watcher -> String -> (Event -> Bool) -> Watched -> IO ()
forall a. Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchDir Watcher
w String
projDir Event -> Bool
isCabal (Project -> [String] -> Watched
WatchedProject Project
proj [String]
opts)
	where
		dirs :: [String]
dirs = (Extensions Path -> String) -> [Extensions Path] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
projDir String -> String -> String
</>) (String -> String)
-> (Extensions Path -> String) -> Extensions Path -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String (Extensions Path) String
-> Extensions Path -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Path -> Const String Path)
-> Extensions Path -> Const String (Extensions Path)
forall a1 a2. Lens (Extensions a1) (Extensions a2) a1 a2
entity ((Path -> Const String Path)
 -> Extensions Path -> Const String (Extensions Path))
-> ((String -> Const String String) -> Path -> Const String Path)
-> Getting String (Extensions Path) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path)) ([Extensions Path] -> [String]) -> [Extensions Path] -> [String]
forall a b. (a -> b) -> a -> b
$ [Extensions Path]
-> (ProjectDescription -> [Extensions Path])
-> Maybe ProjectDescription
-> [Extensions Path]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ProjectDescription -> [Extensions Path]
sourceDirs (Maybe ProjectDescription -> [Extensions Path])
-> Maybe ProjectDescription -> [Extensions Path]
forall a b. (a -> b) -> a -> b
$ Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
-> Project -> Maybe ProjectDescription
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
Lens' Project (Maybe ProjectDescription)
projectDescription Project
proj
		projDir :: String
projDir = Getting String Project String -> Project -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Path -> Const String Path) -> Project -> Const String Project
Lens' Project Path
projectPath ((Path -> Const String Path) -> Project -> Const String Project)
-> ((String -> Const String String) -> Path -> Const String Path)
-> Getting String Project String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path) Project
proj

-- | Watch for standalone source
watchModule :: Watcher -> ModuleLocation -> IO ()
watchModule :: Watcher -> ModuleLocation -> IO ()
watchModule Watcher
w (FileModule Path
f Maybe Project
Nothing) = Watcher -> String -> (Event -> Bool) -> Watched -> IO ()
forall a. Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchDir Watcher
w (String -> String
takeDirectory (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ((String -> Const String String) -> Path -> Const String Path)
-> Path -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path Path
f) Event -> Bool
isSource Watched
WatchedModule
watchModule Watcher
w (FileModule Path
_ (Just Project
proj)) = Watcher -> Project -> [String] -> IO ()
watchProject Watcher
w Project
proj []
watchModule Watcher
_ ModuleLocation
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Watch for top of package-db stack
watchPackageDb :: Watcher -> PackageDbStack -> [String] -> IO ()
watchPackageDb :: Watcher -> PackageDbStack -> [String] -> IO ()
watchPackageDb Watcher
w PackageDbStack
pdbs [String]
opts = case PackageDbStack -> PackageDb
topPackageDb PackageDbStack
pdbs of
	PackageDb
GlobalDb -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO: Watch for global package-db
	PackageDb
UserDb -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO: Watch for user package-db
	(PackageDb Path
pdb) -> Watcher -> String -> (Event -> Bool) -> Watched -> IO ()
forall a. Watcher a -> String -> (Event -> Bool) -> a -> IO ()
watchTree Watcher
w (((String -> Const String String) -> Path -> Const String Path)
-> Path -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path Path
pdb) Event -> Bool
isConf (PackageDbStack -> [String] -> Watched
WatchedPackageDb PackageDbStack
pdbs [String]
opts)

-- | Watch for package-db stack
watchPackageDbStack :: Watcher -> PackageDbStack -> [String] -> IO ()
watchPackageDbStack :: Watcher -> PackageDbStack -> [String] -> IO ()
watchPackageDbStack Watcher
w PackageDbStack
pdbs [String]
opts = (PackageDbStack -> IO ()) -> [PackageDbStack] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\PackageDbStack
pdbs' -> Watcher -> PackageDbStack -> [String] -> IO ()
watchPackageDb Watcher
w PackageDbStack
pdbs' [String]
opts) ([PackageDbStack] -> IO ()) -> [PackageDbStack] -> IO ()
forall a b. (a -> b) -> a -> b
$ PackageDbStack -> [PackageDbStack]
packageDbStacks PackageDbStack
pdbs

unwatchProject :: Watcher -> Project -> IO ()
unwatchProject :: Watcher -> Project -> IO ()
unwatchProject Watcher
w Project
proj = do
	(String -> IO Bool) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Watcher -> String -> IO Bool
forall a. Watcher a -> String -> IO Bool
unwatchTree Watcher
w) [String]
dirs
	IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Watcher -> String -> IO Bool
forall a. Watcher a -> String -> IO Bool
unwatchDir Watcher
w String
projDir
	where
		dirs :: [String]
dirs = (Extensions Path -> String) -> [Extensions Path] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
projDir String -> String -> String
</>) (String -> String)
-> (Extensions Path -> String) -> Extensions Path -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String (Extensions Path) String
-> Extensions Path -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Path -> Const String Path)
-> Extensions Path -> Const String (Extensions Path)
forall a1 a2. Lens (Extensions a1) (Extensions a2) a1 a2
entity ((Path -> Const String Path)
 -> Extensions Path -> Const String (Extensions Path))
-> ((String -> Const String String) -> Path -> Const String Path)
-> Getting String (Extensions Path) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path)) ([Extensions Path] -> [String]) -> [Extensions Path] -> [String]
forall a b. (a -> b) -> a -> b
$ [Extensions Path]
-> (ProjectDescription -> [Extensions Path])
-> Maybe ProjectDescription
-> [Extensions Path]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ProjectDescription -> [Extensions Path]
sourceDirs (Maybe ProjectDescription -> [Extensions Path])
-> Maybe ProjectDescription -> [Extensions Path]
forall a b. (a -> b) -> a -> b
$ Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
-> Project -> Maybe ProjectDescription
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe ProjectDescription) Project (Maybe ProjectDescription)
Lens' Project (Maybe ProjectDescription)
projectDescription Project
proj
		projDir :: String
projDir = Getting String Project String -> Project -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Path -> Const String Path) -> Project -> Const String Project
Lens' Project Path
projectPath ((Path -> Const String Path) -> Project -> Const String Project)
-> ((String -> Const String String) -> Path -> Const String Path)
-> Getting String Project String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path) Project
proj

unwatchModule :: Watcher -> ModuleLocation -> IO ()
unwatchModule :: Watcher -> ModuleLocation -> IO ()
unwatchModule Watcher
w (FileModule Path
f Maybe Project
Nothing) = IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Watcher -> String -> IO Bool
forall a. Watcher a -> String -> IO Bool
unwatchDir Watcher
w (String -> String
takeDirectory (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ((String -> Const String String) -> Path -> Const String Path)
-> Path -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path Path
f)
unwatchModule Watcher
_ (FileModule Path
_ (Just Project
_)) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unwatchModule Watcher
_ InstalledModule{} = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unwatchModule Watcher
_ ModuleLocation
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Unwatch package-db
unwatchPackageDb :: Watcher -> PackageDb -> IO ()
unwatchPackageDb :: Watcher -> PackageDb -> IO ()
unwatchPackageDb Watcher
_ PackageDb
GlobalDb = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO: Unwatch global package-db
unwatchPackageDb Watcher
_ PackageDb
UserDb = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO: Unwatch user package-db
unwatchPackageDb Watcher
w (PackageDb Path
pdb) = IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Watcher -> String -> IO Bool
forall a. Watcher a -> String -> IO Bool
unwatchTree Watcher
w (((String -> Const String String) -> Path -> Const String Path)
-> Path -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (String -> Const String String) -> Path -> Const String Path
Lens' Path String
path Path
pdb)

isSource :: Event -> Bool
isSource :: Event -> Bool
isSource = String -> Bool
haskellSource (String -> Bool) -> (Event -> String) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Event String -> Event -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Event String
Lens' Event String
eventPath

isCabal :: Event -> Bool
isCabal :: Event -> Bool
isCabal = String -> Bool
cabalFile (String -> Bool) -> (Event -> String) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Event String -> Event -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Event String
Lens' Event String
eventPath

isConf :: Event -> Bool
isConf :: Event -> Bool
isConf (Event EventType
_ String
f POSIXTime
_) = String -> String
takeExtension String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".conf"