diff --git a/core-program.cabal b/core-program.cabal --- a/core-program.cabal +++ b/core-program.cabal @@ -1,72 +1,80 @@ cabal-version: 1.12 -name: core-program -version: 0.2.2.4 -license: BSD3 -license-file: LICENSE -copyright: © 2018-2019 Operational Dynamics Consulting Pty Ltd, and Others -maintainer: Andrew Cowie -author: Andrew Cowie -stability: experimental -tested-with: ghc ==8.6.5 -homepage: https://github.com/oprdyn/unbeliever#readme -bug-reports: https://github.com/oprdyn/unbeliever/issues -synopsis: Opinionated Haskell Interoperability -description: - A library to help build command-line programs, both tools and - longer-running daemons. - . - A description of this package, a list of features, and some background - to its design is contained in the - - on GitHub. - . - See "Core.Program.Execute" to get started. -category: System -build-type: Simple +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 4e77f8a52fdda1e7b768f75d3602960d1f59897d2a626c22af12a5f58dc5b38c + +name: core-program +version: 0.2.3.0 +synopsis: Opinionated Haskell Interoperability +description: A library to help build command-line programs, both tools and + longer-running daemons. + . + A description of this package, a list of features, and some background + to its design is contained in the + + on GitHub. + . + See "Core.Program.Execute" to get started. +category: System +stability: experimental +homepage: https://github.com/oprdyn/unbeliever#readme +bug-reports: https://github.com/oprdyn/unbeliever/issues +author: Andrew Cowie +maintainer: Andrew Cowie +copyright: © 2018-2019 Operational Dynamics Consulting Pty Ltd, and Others +license: BSD3 +license-file: LICENSE +tested-with: GHC == 8.6.5 +build-type: Simple + source-repository head - type: git - location: https://github.com/oprdyn/unbeliever + type: git + location: https://github.com/oprdyn/unbeliever library - exposed-modules: - Core.Program - Core.Program.Arguments - Core.Program.Execute - Core.Program.Logging - Core.Program.Metadata - Core.Program.Notify - Core.Program.Unlift - Core.System - Core.System.Base - Core.System.External - hs-source-dirs: lib - other-modules: - Core.Program.Context - Core.Program.Signal - default-language: Haskell2010 - ghc-options: -Wall -Wwarn -fwarn-tabs - build-depends: - async >=2.2.2 && <2.3, - base >=4.11 && <5, - bytestring >=0.10.8.2 && <0.11, - chronologique >=0.3.1.1 && <0.4, - core-data >=0.2.1.4 && <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 && <1.4, - hinotify ==0.4.*, - hourglass >=0.2.12 && <0.3, - mtl >=2.2.2 && <2.3, - prettyprinter >=1.2.1.1 && <1.6, - prettyprinter-ansi-terminal >=1.1.1.2 && <1.2, - safe-exceptions >=0.1.7.0 && <0.2, - stm >=2.5.0.0 && <2.6, - template-haskell >=2.14 && <3, - terminal-size >=0.3.2.1 && <0.4, - text >=1.2.3.1 && <1.3, - text-short >=0.1.3 && <0.2, - transformers >=0.5.6.2 && <0.6, - unix >=2.7.2.2 && <2.8 + exposed-modules: + Core.Program + Core.Program.Arguments + Core.Program.Execute + Core.Program.Logging + Core.Program.Metadata + Core.Program.Notify + Core.Program.Unlift + Core.System + Core.System.Base + Core.System.External + Core.System.Pretty + other-modules: + Core.Program.Context + Core.Program.Signal + hs-source-dirs: + lib + ghc-options: -Wall -Wwarn -fwarn-tabs + build-depends: + async + , base >=4.11 && <5 + , bytestring + , chronologique + , core-data + , core-text >=0.2.2 + , directory + , exceptions + , filepath + , fsnotify + , hashable >=1.2 && <1.4 + , hourglass + , mtl + , prettyprinter >=1.2.1.1 && <1.6 + , prettyprinter-ansi-terminal + , safe-exceptions + , stm + , template-haskell >=2.14 && <3 + , terminal-size + , text + , text-short + , transformers + , unix + default-language: Haskell2010 diff --git a/lib/Core/Program/Notify.hs b/lib/Core/Program/Notify.hs --- a/lib/Core/Program/Notify.hs +++ b/lib/Core/Program/Notify.hs @@ -11,70 +11,73 @@ ) 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 System.FilePath (dropFileName) +import System.FSNotify (Event(..), withManager, watchDir, eventPath) import Core.Data.Structures import Core.Program.Execute import Core.Program.Logging import Core.Program.Unlift +import System.Directory (canonicalizePath) +import Control.Monad.IO.Class (liftIO) + {-| 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. +Before continuing we insert a 100ms pause to allow whatever the editor was to +finish its write and switcheroo sequence. -} +-- +-- 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 by inotify +-- on Linux through these sequences. We need to continue testing to assure +-- ourselves that the __fsnotify__ package's @Modify@ represents this +-- accurately. +-- waitForChange :: [FilePath] -> Program τ () waitForChange files = let - f :: FilePath -> Set C.ByteString -> Set C.ByteString - f path acc = insertElement (C.pack path) acc + f :: FilePath -> Set FilePath -> Set FilePath + f path acc = insertElement path acc - g :: FilePath -> Set C.ByteString -> Set C.ByteString - g path acc = insertElement (C.pack (dropFileName path)) acc + g :: FilePath -> Set FilePath -> Set FilePath + g path acc = insertElement (dropFileName path) acc in do event "Watching for changes" - let paths = foldr f emptySet files + canonical <- mapM (liftIO . canonicalizePath) files + let paths = foldr f emptySet canonical let dirs = foldr g emptySet files withContext $ \runProgram -> do block <- newEmptyMVar - withINotify $ \notify -> do - -- setup inotifies - watches <- foldrM (\dir acc -> do + withManager $ \manager -> do + -- setup watches + stoppers <- 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 + stopper <- watchDir manager dir + (\trigger -> case trigger of + Modified file _ _ -> do + if containsElement file paths + then True + else False + _ -> False + ) + (\trigger -> do + runProgram (debugS "trigger" (eventPath trigger)) + putMVar block False + ) + return (stopper:acc)) [] dirs -- wait _ <- readMVar block - -- cleanup - mapM_ removeWatch watches + sequence_ stoppers + return () sleep 0.1 diff --git a/lib/Core/System.hs b/lib/Core/System.hs --- a/lib/Core/System.hs +++ b/lib/Core/System.hs @@ -33,8 +33,19 @@ contact with. -} , module Core.System.External + + {-* Pretty Printing -} +{-| +When using the Render typeclass from "Core.Text.Utilities" you are +presented with the @Doc a@ type for accumulating a \"document\" to be +pretty printed. There are a large family of combinators used when doing +this. For convenience they are exposed here. +-} + , module Core.System.Pretty + ) where import Core.System.Base import Core.System.External +import Core.System.Pretty diff --git a/lib/Core/System/Pretty.hs b/lib/Core/System/Pretty.hs new file mode 100644 --- /dev/null +++ b/lib/Core/System/Pretty.hs @@ -0,0 +1,52 @@ +{-# OPTIONS_HADDOCK not-home #-} + +-- +-- | Re-exports of combinators for use when building 'Render' instances. +-- +module Core.System.Pretty + ( {-* Pretty Printing -} + {-** from Data.Text.Prettyprint.Doc -} + {-| Re-exported from "Data.Text.Prettyprint.Doc" in __prettyprinter__ + and "Data.Text.Prettyprint.Doc.Render.Terminal" in + __prettyprinter-ansi-terminal__: -} + Doc + , Pretty(pretty) + , dquote + , comma + , punctuate + , lbracket + , rbracket + , (<+>) + , lbrace + , rbrace + , lparen + , rparen + , emptyDoc + , sep + , hsep + , vsep + , fillSep + , flatAlt + , hcat + , vcat + , annotate + , unAnnotate + , line + , line' + , softline + , softline' + , hardline + , group + , hang + , indent + , nest + , concatWith + , color + , colorDull + , Color(..) + , AnsiStyle + , bold + ) where + +import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Render.Terminal