Hclip 1.0.0.0 → 1.0.0.1

raw patch · 2 files changed

+47/−52 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Hclip.cabal +1/−1
• System/Hclip.hs +46/−51

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             1.0.0.0+version:             1.0.0.1  -- A short (one-line) description of the package. synopsis:            A small cross-platform library for reading and modifying the system clipboard.

@@ -49,9 +49,10 @@   -- | Supported Operating Systems-data Linux = Linux deriving (Show)-data Darwin = Darwin deriving (Show)-data Windows = Windows deriving (Show)+data Platform = Linux+              | Darwin+              | Windows+                deriving (Show)   -- | Error Types@@ -77,27 +78,22 @@ type ErrorWithIO = ErrorT ClipboardError IO  --- | type class for supported operating systems-class SupportedOS a where-  clipboard :: a -> Command -> IO (Either ClipboardError String)----- | read clipboard contents+-- | Read clipboard contents. getClipboard :: IO (Either ClipboardError String) getClipboard = dispatchCommand GetClipboard  --- | set clipboard contents+-- | Set clipboard contents. setClipboard :: String -> IO (Either ClipboardError String) setClipboard = dispatchCommand . SetClipboard  --- | apply function to clipboard and return the new contents+-- | Apply function to clipboard and return its new contents. modifyClipboard :: (String -> String) -> IO (Either ClipboardError String) modifyClipboard = flip (liftM . liftM) getClipboard >=> either (return . throwError) setClipboard  --- | select the supported operating system+-- | Select the supported operating system. dispatchCommand :: Command -> IO (Either ClipboardError String) dispatchCommand = case os of   "linux" -> clipboard Linux@@ -109,55 +105,54 @@   -- | MAC OS: use pbcopy and pbpaste    -instance SupportedOS Darwin where-  clipboard Darwin GetClipboard = runErrorT $ withExternalCommand "pbcopy" GetClipboard    -  clipboard Darwin c@(SetClipboard s) = runErrorT $ withExternalCommand "pbpaste" c+clipboard Darwin command = Right `fmap` withExternalCommand extCmd command+  where extCmd = case command of+                   GetClipboard   -> "pbcopy"+                   SetClipboard _ -> "pbpaste"   -- | Linux: use xsel or xclip-instance SupportedOS Linux where-  clipboard Linux command = runErrorT $ do-    prog <- chooseFirstCommand ["xsel", "xclip"]-    withExternalCommand (decode prog command) command-    where-      decode "xsel" GetClipboard = "xsel -o"-      decode "xsel" (SetClipboard _) = "xsel -i"-      decode "xclip" GetClipboard = "xclip -selection c -o"-      decode "xclip" (SetClipboard _) = "xclip -selection c"+clipboard Linux command = runErrorT $ do+  prog <- chooseFirstCommand ["xsel", "xclip"]+  liftIO $ withExternalCommand (decode prog command) command+  where+    decode "xsel" GetClipboard = "xsel -o"+    decode "xsel" (SetClipboard _) = "xsel -i"+    decode "xclip" GetClipboard = "xclip -selection c -o"+    decode "xclip" (SetClipboard _) = "xclip -selection c"       -- | Windows: use WinAPI #if defined(mingw32_HOST_OS) || defined(__MINGW32__)-instance SupportedOS Windows where-  clipboard Windows GetClipboard = -    bracket_ (openClipboard nullPtr) closeClipboard $ do-      isText <- isClipboardFormatAvailable cF_TEXT-      if isText-        then do -          h <- getClipboardData cF_TEXT-          bracket (globalLock h) globalUnlock $ liftM Right . peekCAString . castPtr-        else return $ throwError NoTextualData+clipboard Windows GetClipboard = +  bracket_ (openClipboard nullPtr) closeClipboard $ do+    isText <- isClipboardFormatAvailable cF_TEXT+    if isText+      then do +        h <- getClipboardData cF_TEXT+        bracket (globalLock h) globalUnlock $ liftM Right . peekCAString . castPtr+      else return $ throwError NoTextualData -  clipboard Windows (SetClipboard s) = -    withCAString s $ \cstr -> do-      mem <- globalAlloc gHND memSize-      bracket (globalLock mem) globalUnlock $ \space -> do-        copyMemory space (castPtr cstr) memSize-        bracket_ (openClipboard nullPtr) closeClipboard $ do-          emptyClipboard-          setClipboardData cF_TEXT space-          return $ Right s-    where-      memSize = genericLength s + 1+clipboard Windows (SetClipboard s) = +  withCAString s $ \cstr -> do+    mem <- globalAlloc gHND memSize+    bracket (globalLock mem) globalUnlock $ \space -> do+      copyMemory space (castPtr cstr) memSize+      bracket_ (openClipboard nullPtr) closeClipboard $ do+        emptyClipboard+        setClipboardData cF_TEXT space+        return $ Right s+  where+    memSize = genericLength s + 1 #endif  --- | run external command for accessing the system clipboard-withExternalCommand :: String -> Command -> ErrorWithIO String+-- | Run external command for accessing the system clipboard.+withExternalCommand :: String -> Command -> IO String withExternalCommand prog command = -  liftIO $ bracket (runInteractiveCommand prog)-                   (\(inp, outp, stderr, _) -> mapM_ hClose [inp, outp, stderr])-                   (\(inp, outp, _, _) -> (action command) (inp, outp))+  bracket (runInteractiveCommand prog)+          (\(inp, outp, stderr, _) -> mapM_ hClose [inp, outp, stderr])+          (\(inp, outp, _, _) -> action command (inp, outp))   where     action GetClipboard = hGetContents . stdout     action (SetClipboard text) = (flip hPutStr text >=> const (return text)) . stdin@@ -165,7 +160,7 @@     stdout = snd  --- | search for installed programs and return the first match+-- | Search for installed programs and return the first match. chooseFirstCommand :: [String] -> ErrorWithIO String chooseFirstCommand cmds = do   results <- liftIO $ mapM whichCommand cmds@@ -174,7 +169,7 @@         (getFirst . mconcat $ map First results)  --- | use the which-command to check if cmd is installed+-- | Check if cmd is installed using the which command. whichCommand :: String -> IO (Maybe String) whichCommand cmd = do   (exitCode,_,_) <- readProcessWithExitCode "which" [cmd] ""