{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -w #-}
module Uniform.Watch
( module Uniform.Watch
, forkIO, killThread
) where
import Twitch hiding (Options, log)
import GHC.Conc.Sync
import qualified Twitch
import Control.Concurrent (forkIO, killThread)
import UniformBase hiding (S, (<.>), (</>))
newtype Glob = Glob Text
deriving (Int -> Glob -> ShowS
[Glob] -> ShowS
Glob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Glob] -> ShowS
$cshowList :: [Glob] -> ShowS
show :: Glob -> String
$cshow :: Glob -> String
showsPrec :: Int -> Glob -> ShowS
$cshowsPrec :: Int -> Glob -> ShowS
Show, ReadPrec [Glob]
ReadPrec Glob
Int -> ReadS Glob
ReadS [Glob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Glob]
$creadListPrec :: ReadPrec [Glob]
readPrec :: ReadPrec Glob
$creadPrec :: ReadPrec Glob
readList :: ReadS [Glob]
$creadList :: ReadS [Glob]
readsPrec :: Int -> ReadS Glob
$creadsPrec :: Int -> ReadS Glob
Read, Glob -> Glob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Glob -> Glob -> Bool
$c/= :: Glob -> Glob -> Bool
== :: Glob -> Glob -> Bool
$c== :: Glob -> Glob -> Bool
Eq, forall x. Rep Glob x -> Glob
forall x. Glob -> Rep Glob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Glob x -> Glob
$cfrom :: forall x. Glob -> Rep Glob x
Generic)
unGlob :: Glob -> Text
unGlob (Glob Text
a) = Text
a
multipleWatches :: [WatchOpType] -> ErrIO [GHC.Conc.Sync.ThreadId]
multipleWatches :: [WatchOpType] -> ErrIO [ThreadId]
multipleWatches [WatchOpType]
ws = do
[ThreadId]
is <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WatchOpType -> ErrIO ThreadId
mainWatch2one [WatchOpType]
ws
forall (m :: * -> *) a. Monad m => a -> m a
return [ThreadId]
is
where
mainWatch2one :: WatchOpType -> ErrIO GHC.Conc.Sync.ThreadId
mainWatch2one :: WatchOpType -> ErrIO ThreadId
mainWatch2one WatchOpType
w = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (ErrIO () -> IO ()
runErrorVoid forall a b. (a -> b) -> a -> b
$ (Show [Text], Show (Path Abs Dir)) => WatchOpType -> ErrIO ()
startWatch2 WatchOpType
w)
twichDefault4ssg :: Options
twichDefault4ssg =
Twitch.Options
{ log :: LoggerType
Twitch.log = LoggerType
NoLogger
, logFile :: Maybe String
logFile = forall a. Maybe a
Nothing
, root :: Maybe String
root = forall a. Maybe a
Nothing
, recurseThroughDirectories :: Bool
recurseThroughDirectories = Bool
True
, debounce :: DebounceType
debounce = DebounceType
Debounce
, debounceAmount :: Double
debounceAmount = Double
1
, pollInterval :: Int
pollInterval = Int
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
6 :: Int)
, usePolling :: Bool
usePolling = Bool
False
}
type WatchOpType = (Path Abs Dir, (FilePath -> ErrIO ()), [Glob])
makeWatch :: a -> b -> c -> (a, b, c)
makeWatch a
a b
b c
c = (a
a,b
b,c
c)
startWatch2 :: (Show [Text], Show (Path Abs Dir))
=> WatchOpType -> ErrIO ()
startWatch2 :: (Show [Text], Show (Path Abs Dir)) => WatchOpType -> ErrIO ()
startWatch2 (Path Abs Dir
path1,String -> ErrIO ()
op,[Glob]
globs) = do
let globs2 :: [Dep]
globs2 = forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall b c a. (b -> c) -> (a -> b) -> a -> c
. Glob -> Text
unGlob) [Glob]
globs :: [Dep]
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"startWatch2", Text
"\n\tpath1", forall {a}. Show a => a -> Text
showT Path Abs Dir
path1, Text
"\n\textensions", forall {a}. Show a => a -> Text
showT [Glob]
globs]
forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ do
Options -> Dep -> IO ()
Twitch.defaultMainWithOptions
(Options
twichDefault4ssg
{root :: Maybe String
Twitch.root = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs Dir
path1, log :: LoggerType
Twitch.log = LoggerType
Twitch.NoLogger})
forall a b. (a -> b) -> a -> b
$ do
let deps :: [Dep]
deps = forall a b. (a -> b) -> [a] -> [b]
map ((String -> ErrIO ()) -> Dep -> Dep
setTwichAddModifyDelete String -> ErrIO ()
op) [Dep]
globs2 :: [Dep]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Dep]
deps
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"startWatch2", Text
"end"]
setTwichAddModifyDelete :: (FilePath -> ErrIO ()) -> Dep -> Dep
setTwichAddModifyDelete :: (String -> ErrIO ()) -> Dep -> Dep
setTwichAddModifyDelete String -> ErrIO ()
op Dep
ext =
forall a. (String -> IO a) -> Dep -> Dep
Twitch.addModify (\String
filepath -> ErrIO () -> IO ()
runErrorVoid forall a b. (a -> b) -> a -> b
$ String -> ErrIO ()
op String
filepath) (Dep
ext :: Dep)
runErrorRepl :: (Show a) => a -> IO ()
runErrorRepl :: forall a. Show a => a -> IO ()
runErrorRepl a
a = do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"runErrorRepl", Text
"input is", forall {a}. Show a => a -> Text
showT a
a]
forall (m :: * -> *) a. Monad m => a -> m a
return ()
watchMain :: [WatchOpType] -> ErrIO () -> ErrIO ()
watchMain :: [WatchOpType] -> ErrIO () -> ErrIO ()
watchMain [WatchOpType]
watches ErrIO ()
foreverOp =
forall a b c.
ErrIO a -> (a -> ErrIO b) -> (a -> ErrIO c) -> ErrIO c
bracketErrIO
(do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"mainWatch started"]
[ThreadId]
watchTIDs <- [WatchOpType] -> ErrIO [ThreadId]
multipleWatches [WatchOpType]
watches
ErrIO ()
foreverOp
forall (m :: * -> *) a. Monad m => a -> m a
return [ThreadId]
watchTIDs
)
(\[ThreadId]
watchTIDs
-> do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"main watch end"]
forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ThreadId -> IO ()
killThread [ThreadId]
watchTIDs
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
(\[ThreadId]
_
-> do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"mainWatch run"]
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"mainWatch run end "]
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)