diff --git a/LICENCE b/LICENCE deleted file mode 100644 --- a/LICENCE +++ /dev/null @@ -1,32 +0,0 @@ -Opinionated Haskell Interoperability - -Copyright © 2018-2019 Operational Dynamics Consulting, Pty Ltd and Others -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - 3. Neither the name of the project nor the names of its contributors - may be used to endorse or promote products derived from this - software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,32 @@ +Opinionated Haskell Interoperability + +Copyright © 2018-2019 Operational Dynamics Consulting, Pty Ltd and Others +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + 3. Neither the name of the project nor the names of its contributors + may be used to endorse or promote products derived from this + software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/core-program.cabal b/core-program.cabal --- a/core-program.cabal +++ b/core-program.cabal @@ -1,8 +1,8 @@ cabal-version: 1.12 name: core-program -version: 0.2.1.0 +version: 0.2.2.0 license: BSD3 -license-file: LICENCE +license-file: LICENSE copyright: © 2018-2019 Operational Dynamics Consulting Pty Ltd, and Others maintainer: Andrew Cowie author: Andrew Cowie @@ -35,6 +35,7 @@ Core.Program.Execute Core.Program.Logging Core.Program.Metadata + Core.Program.Notify Core.Program.Unlift Core.System Core.System.Base @@ -50,11 +51,13 @@ base >=4.11 && <5, bytestring >=0.10.8.2 && <0.11, chronologique >=0.3.1.1 && <0.4, - core-data >=0.2.0.0 && <0.3, - core-text >=0.2.0.1 && <0.3, + core-data >=0.2.1.0 && <0.3, + core-text >=0.2.2 && <0.3, directory >=1.3.3.0 && <1.4, exceptions >=0.10.3 && <0.11, + filepath >=1.4.2.1 && <1.5, hashable >=1.2.7.0 && <1.3, + hinotify ==0.4.*, hourglass >=0.2.12 && <0.3, mtl >=2.2.2 && <2.3, prettyprinter >=1.2.1.1 && <1.3, diff --git a/lib/Core/Program.hs b/lib/Core/Program.hs --- a/lib/Core/Program.hs +++ b/lib/Core/Program.hs @@ -36,11 +36,19 @@ Facilities for noting events through your program and doing debugging. -} , module Core.Program.Logging + +{-| +There are a few common use cases which require a bit of wrapping to use +effectively. Watching files for changes and taking action in the event of a +change is one. +-} + , module Core.Program.Notify ) where import Core.Program.Arguments import Core.Program.Execute import Core.Program.Logging import Core.Program.Metadata +import Core.Program.Notify import Core.Program.Unlift diff --git a/lib/Core/Program/Arguments.hs b/lib/Core/Program/Arguments.hs --- a/lib/Core/Program/Arguments.hs +++ b/lib/Core/Program/Arguments.hs @@ -87,6 +87,10 @@ instance Pretty LongName where pretty (LongName name) = pretty name +instance Textual LongName where + intoRope (LongName str) = intoRope str + fromRope = LongName . fromRope + {-| The setup for parsing the command-line arguments of your program. You build a @Config@ with 'simple' or 'complex', and pass it to diff --git a/lib/Core/Program/Notify.hs b/lib/Core/Program/Notify.hs new file mode 100644 --- /dev/null +++ b/lib/Core/Program/Notify.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune #-} + +{-| +Helpers for watching files for changes and taking action in the event of a +change. +-} +module Core.Program.Notify + ( {-* Notify -} + waitForChange + ) where + +import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar) +import qualified Data.ByteString.Char8 as C (ByteString, pack) +import Data.Foldable (foldr, foldrM) +import System.FilePath.Posix (dropFileName) +import System.INotify (EventVariety(..), Event(..), withINotify + , addWatch, removeWatch) + +import Core.Data.Structures +import Core.Program.Execute +import Core.Program.Logging +import Core.Program.Unlift + +{-| +Watch for changes to a given list of files. + +Ideally we'd just set up inotifies on these individual files, but that +doesn't work when programs like vim move the original file, save a new one, +then delete the renamed original. From previous work we know that +@CLOSE_WRITE@ is emitted reliably through these sequences, so we can just +check to see if a that happens on a filename we care about (rather then the +original inodes those files were stored in). + +Before continuing we insert a 100ms pause to allow whatever the editor was +to finish its write and switcheroo sequence. +-} +waitForChange :: [FilePath] -> Program τ () +waitForChange files = + let + f :: FilePath -> Set C.ByteString -> Set C.ByteString + f path acc = insertElement (C.pack path) acc + + g :: FilePath -> Set C.ByteString -> Set C.ByteString + g path acc = insertElement (C.pack (dropFileName path)) acc + in do + event "Watching for changes" + + let paths = foldr f emptySet files + let dirs = foldr g emptySet files + + withContext $ \runProgram -> do + block <- newEmptyMVar + withINotify $ \notify -> do + -- setup inotifies + watches <- foldrM (\dir acc -> do + runProgram (debugS "watching" dir) + watch <- addWatch notify [CloseWrite] dir (\trigger -> + case trigger of + Closed _ (Just file) _ -> do + let path = if dir == "./" + then file + else dir <> file + runProgram (debugS "changed" path) + if containsElement path paths + then do + runProgram (debugS "trigger" path) + putMVar block False + else + return () + _ -> return ()) + return (watch:acc)) [] dirs + + -- wait + _ <- readMVar block + + -- cleanup + mapM_ removeWatch watches + + sleep 0.1