-----------------------------------------------------------------------------
--
-- Module      :  Uniform.watch
--
-- | a miniaml set of
-----------------------------------------------------------------------------
-- {-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric  #-}

-- runErrorT is  but used in monads-tf
{-# OPTIONS_GHC -w #-}

-- {-# LANGUAGE PackageImports        #-}
-- {-# LANGUAGE TypeSynonymInstances  #-}
-- {-# OPTIONS_GHC  -fno-warn-warnings-deprecations #-}
module Uniform.Watch
  ( module Uniform.Watch
  , forkIO, killThread
  ) where

import Twitch hiding (Options, log)
import GHC.Conc.Sync
import qualified Twitch

--import Control.Concurrent.Spawn
-- import Control.Concurrent
import           Control.Concurrent (forkIO, killThread)
-- import Uniform.FileIO
-- import Uniform.Strings hiding (S, (<.>), (</>))
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)
-- the globs used here (possibly use the type from system-filepath-glob
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 -- second? NominalTimeDifference
    , pollInterval :: Int
pollInterval = Int
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
6 :: Int) -- 1 second
    , 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 ()
-- | start watching for a set of files (glob patterns) in one directory
-- essentially producing lines in the minimal twitch example with a single operation
startWatch2 :: (Show [Text], Show (Path Abs Dir)) => WatchOpType -> ErrIO ()
startWatch2 (Path Abs Dir
path1,String -> ErrIO ()
op,[Glob]
globs) = do
  -- putIOwords ["startWatch2", "\n\tpath1", showT path1, "\n\textensions", showT exts]
    -- the path1 is dir to watch -- should probably be fixed to absolute
  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"]

      -- return ()

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)
    -- do not simplify, needs lambda for Twitch 
    -- addModify :: (FilePath -> IO a) -> Dep -> Dep

runErrorRepl :: (Show a) => a -> IO ()
-- just for testing when an event is triggered
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 = -- callIO $ defaultMain $ 
    forall a b c.
ErrIO a -> (a -> ErrIO b) -> (a -> ErrIO c) -> ErrIO c
bracketErrIO
        (do
            -- first
            forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"mainWatch started"]
            -- watchTID <- callIO $ forkIO (runErrorVoid $ testWatch)
            [ThreadId]
watchTIDs <- [WatchOpType] -> ErrIO [ThreadId]
multipleWatches [WatchOpType]
watches
            ErrIO ()
foreverOp -- just to make it run forever
                  
            forall (m :: * -> *) a. Monad m => a -> m a
return [ThreadId]
watchTIDs 
            )
        (\[ThreadId]
watchTIDs      -- last
        -> 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]
_         -- during
        -> do
            forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"mainWatch run"]
            -- brackets the runs of shake runs 
            forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"mainWatch run end "]
            forall (m :: * -> *) a. Monad m => a -> m a
return ()
            )