packages feed

hs-rs-notify (empty) → 0.1.0.0

raw patch · 10 files changed

+221/−0 lines, 10 filesdep +basedep +filepathdep +hs-rs-notifysetup-changedbinary-added

Dependencies added: base, filepath, hs-rs-notify, process, protolude, text, unix

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright NoRedInk (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Author name here nor the names of other+      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.
+ README.md view
@@ -0,0 +1,5 @@+# hs-rs-notify++experimental! no docs yet++Wraps this awesome rust library so you can use it in haskell. https://docs.rs/crate/notify
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,14 @@+import Notify+import Protolude++main :: IO ()+main = do+  watch "/Users/stoeffel/nri/noredink" [".elm"] callback+  putText "done"++callback :: Event -> IO ()+callback event = do+  putText "Callback"+  print event+  threadDelay 10000000+  putText "done"
+ hs-rs-notify.cabal view
@@ -0,0 +1,57 @@+name:                hs-rs-notify+version:             0.1.0.0+synopsis:            Experimental! Wraps this awesome rust library so you can use it in haskell. https://docs.rs/crate/notify+-- description:+homepage:            https://github.com/NoRedInk/hs-rs-notify#readme+license:             BSD3+license-file:        LICENSE+author:              Author name here+maintainer:          example@example.com+copyright:           2018 Author name here+category:            Web+build-type:          Simple+extra-source-files:  README.md+                   , notifier/target/release/libnotifier.a+                   , notifier/target/release/libnotifier.d+                   , notifier/target/release/libnotifier.dylib+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  ghc-options:         -Wall+  exposed-modules:     Notify+  build-depends:       base >= 4.7 && < 5+                     , protolude >= 0.1.6 && < 0.2+                     , text == 1.2.2.2+                     , filepath == 1.4.1.1+                     , unix == 2.7.2.1+                     , process == 1.4.3.0+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings, NoImplicitPrelude++executable hs-rs-notify+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , hs-rs-notify+                     , protolude >= 0.1.6 && < 0.2+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings, NoImplicitPrelude+  extra-libraries:     notifier, pthread+  extra-lib-dirs:      ./notifier/target/release++test-suite hs-rs-notify-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , hs-rs-notify+                     , protolude >= 0.1.6 && < 0.2+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings, NoImplicitPrelude++source-repository head+  type:     git+  location: https://github.com/githubuser/hs-rs-notify
+ notifier/target/release/libnotifier.a view

file too large to diff

+ notifier/target/release/libnotifier.d view
@@ -0,0 +1,1 @@+/Users/stoeffel/nri/notify/hs-rf-notify/notifier/target/release/libnotifier.dylib: /Users/stoeffel/nri/notify/hs-rf-notify/notifier/src/lib.rs
+ notifier/target/release/libnotifier.dylib view

binary file changed (absent → 2096632 bytes)

+ src/Notify.hs view
@@ -0,0 +1,108 @@+{-|+Module      : Notify+Description : Notify's main module++This is a haddock comment describing your library+For more information on how to write Haddock comments check the user guide:+<https://www.haskell.org/haddock/doc/html/index.html>+-}+module Notify where++import Control.Concurrent+import Control.Exception (bracket)+import Control.Monad (when)+import Data.Foldable+import Data.Text as T+import Foreign.C.String+import Foreign.ForeignPtr+import Foreign.Ptr+import Protolude+import System.FilePath+import System.Posix.Process+import System.Posix.Signals+import System.Posix.Types (ProcessID)+import System.Process++data Event+  = NoticeWrite FilePath+  | NoticeRemove FilePath+  | Create FilePath+  | Write FilePath+  | Chmod FilePath+  | Remove FilePath+  | Rename FilePath+           FilePath+  | Rescan+  | Error T.Text+          (Maybe FilePath)+  | Unknown+  deriving (Show)++foreign import ccall "watch_for_changes" watchForChanges ::+               CString -> FunPtr (CString -> CString -> CString -> IO ()) -> IO ()++foreign import ccall "wrapper" mkCallback ::+               (CString -> CString -> CString -> IO ()) ->+                 IO (FunPtr (CString -> CString -> CString -> IO ()))++watch :: T.Text -> [T.Text] -> (Event -> IO ()) -> IO ()+watch path extensions callback = do+  mVar <- newMVar Nothing+  cb <- mkCallback $ forkCallback mVar callback extensions+  pathCStr <- newCString $ T.unpack path+  watchForChanges pathCStr cb++forkCallback ::+     MVar (Maybe ProcessID)+  -> (Event -> IO ())+  -> [T.Text]+  -> CString+  -> CString+  -> CString+  -> IO ()+forkCallback mVar cb extensions eventC aC bC = do+  eventStr <- T.pack <$> peekCString eventC+  a <- T.pack <$> peekCString aC+  b <- T.pack <$> peekCString bC+  let event = toEvent eventStr a b+  when (relevantEvent event extensions) $ do+    runningProcess <- takeMVar mVar+    traverse_ (signalProcess softwareTermination) runningProcess+    traverse_ (getProcessStatus True False) runningProcess -- here be dragons, potentially+    processId <- forkProcess (cb event)+    putMVar mVar (Just processId)++toEvent :: T.Text -> T.Text -> T.Text -> Event+toEvent "NoticeWrite" _ b = NoticeWrite (T.unpack b)+toEvent "NoticeRemove" _ b = NoticeRemove (T.unpack b)+toEvent "Create" _ b = Create (T.unpack b)+toEvent "Write" _ b = Write (T.unpack b)+toEvent "Chmod" _ b = Chmod (T.unpack b)+toEvent "Remove" _ b = Remove (T.unpack b)+toEvent "Rename" a b = Rename (T.unpack a) (T.unpack b)+toEvent "Rescan" _ _ = Rescan+toEvent "Error" msg path =+  Error+    msg+    (case path of+       "" -> Nothing+       _ -> Just (T.unpack path))+toEvent _ _ _ = Unknown++relevantEvent :: Event -> [T.Text] -> Bool+relevantEvent event extensions =+  case eventForFile event of+    Just path -> elem (T.pack (takeExtension path)) extensions+    Nothing -> False++eventForFile :: Event -> Maybe FilePath+eventForFile (NoticeWrite path) = Just path+eventForFile (NoticeRemove path) = Just path+eventForFile (Create path) = Just path+eventForFile (Write path) = Just path+eventForFile (Chmod path) = Just path+eventForFile (Remove path) = Just path+eventForFile (Rename _ path) = Just path+eventForFile Rescan = Nothing+eventForFile (Error _ maybePath) = maybePath+eventForFile Unknown = Nothing
+ test/Spec.hs view
@@ -0,0 +1,4 @@+import Protolude++main :: IO ()+main = putStrLn ("Test suite not yet implemented" :: Text)