greenclip (empty) → 1.3.0
raw patch · 4 files changed
+280/−0 lines, 4 filesdep +Clipboarddep +basedep +binary
Dependencies added: Clipboard, base, binary, classy-prelude, directory, microlens, microlens-mtl, text, vector
Files
- LICENSE +30/−0
- README.md +45/−0
- greenclip.cabal +37/−0
- src/Main.hs +168/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Romain GÉRARD (c) 2016++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,45 @@+<p align="center">+ <img src="https://github.com/erebe/greenclip/raw/master/logo.png" alt="logo"/>+</p>++## Description++Recyle your clipboard selections with greenclip and don't waste your time anymore+to reselect things other and other.++**Purpose :**+Keeps track of your history of selections to quickly switch between them++**Demo :** +<video controls>+ <source src="https://github.com/erebe/greenclip/releases/download/1.1/demo.webm" type="video/webm">+ <a href="https://www.youtube.com/watch?v=Utk-9Gy8H3w">Video Link</a>+</video>++**Installation :**++1. It's a static binary so drop it anywhere in your $PATH env ++```wget https://github.com/erebe/greenclip/releases/download/1.3/greenclip```++Alternatively if you are using Archlinux you can install the package from AUR++``pacman -S greenclip``++PS: If you want, you can add a permanent list of selections to be added to your current history. Go see the config file+++**Usage :**++Greenclip is intended to be used with [rofi](https://github.com/DaveDavenport/rofi)++1. Spawn the daemon ``` greenclip daemon ```+2. When ever you need to get your selections history ``` rofi -modi "clipboard:greenclip print" -show clipboard ```+3. The entry that you have selected will be in your clipboard now+4. Configuration file can be found in ```.config/greenclip.cfg```++**Compilation :**++1. Get [stack](https://docs.haskellstack.org/en/stable/README/) for Haskell+2. stack init && stack install+
+ greenclip.cabal view
@@ -0,0 +1,37 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name: greenclip+version: 1.3.0+synopsis: Simple clipboard manager to be integrated with rofi+description: Please see README.md+category: Linux Desktop+homepage: https://github.com/erebe/greenclip#readme+author: Erèbe - Romain GERARD+maintainer: romain.gerard@erebe.eu+copyright: 2016 Erèbe+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md++executable greenclip+ main-is: Main.hs+ hs-source-dirs:+ src+ ghc-options: -Wall -O3+ build-depends:+ base >= 4.7 && < 5+ , classy-prelude+ , Clipboard+ , text+ , vector+ , binary+ , microlens+ , microlens-mtl+ , directory+ default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++import ClassyPrelude as CP hiding (readFile)+import Data.Binary (decode, encode)+import qualified Data.Text as T+import qualified Data.Vector as V+import Lens.Micro+import Lens.Micro.Mtl+import qualified System.Clipboard as Clip+import qualified System.Directory as Dir+import System.Environment (lookupEnv)+import System.IO (IOMode (..), openFile)+import System.Timeout (timeout)+++data Command = DAEMON | PRINT | COPY Text | CLEAR | HELP deriving (Show, Read)++data Config = Config+ { maxHistoryLength :: Int+ , historyPath :: String+ , staticHistoryPath :: String+ , usePrimarySelectionAsInput :: Bool+ } deriving (Show, Read)++type ClipHistory = Vector Text++readFile :: FilePath -> IO ByteString+readFile filepath = bracket (openFile filepath ReadMode) hClose $ \h -> do+ str <- hGetContents h+ let !str' = str+ return str'+++getHistory :: (MonadIO m, MonadReader Config m) => m ClipHistory+getHistory = do+ storePath <- view (to historyPath)+ liftIO $ readH storePath `catchAnyDeep` const mempty+ where+ readH filePath = readFile filePath <&> fromList . decode . fromStrict++getStaticHistory :: (MonadIO m, MonadReader Config m) => m ClipHistory+getStaticHistory = do+ storePath <- view (to staticHistoryPath)+ liftIO $ readH storePath `catchAnyDeep` const mempty+ where+ readH filePath = readFile filePath <&> fromList . T.lines . decodeUtf8+++storeHistory :: (MonadIO m, MonadReader Config m) => ClipHistory -> m ()+storeHistory history = do+ storePath <- view (to historyPath)+ liftIO $ writeH storePath history `catchAnyDeep` const mempty+ where+ writeH storePath = writeFile storePath . toStrict . encode . toList++appendToHistory :: (MonadIO m, MonadReader Config m) => Text -> ClipHistory -> m ClipHistory+appendToHistory sel history =+ let selection = T.strip sel in+ if selection == mempty || selection == fromMaybe mempty (headMay history)+ then return history+ else do+ maxLen <- view (to maxHistoryLength)+ return $ fst . V.splitAt maxLen . cons selection $ filter (/= selection) history+++runDaemon :: (MonadIO m, MonadReader Config m, MonadCatch m) => m ()+runDaemon = do+ usePrimary <- view (to usePrimarySelectionAsInput)+ let getSelections = (getSelectionFrom Clip.getClipboardString, mempty)+ : [(getSelectionFrom Clip.getPrimaryClipboard, mempty) | usePrimary]+ forever $ (getHistory >>= go getSelections) `catchAnyDeep` handleError++ where+ _0_5sec :: Int+ _0_5sec = 5 * 10^(5::Int)++ getSelection [] = return ([], mempty)+ getSelection ((getSel, lastSel):getSels) = do+ selection <- liftIO getSel+ if selection /= lastSel+ then return ((getSel, selection) : getSels, selection)+ else getSelection getSels >>= \(e, selection) -> return ((getSel, lastSel) : e, selection)++ go getSelections history = do+ (getSelections', selection) <- liftIO $ getSelection getSelections+ history' <- appendToHistory selection history+ when (history' /= history) (storeHistory history')++ liftIO $ threadDelay _0_5sec+ go getSelections' history'++ getSelectionFrom fn = timeout 1000000 fn <&> T.pack . fromMaybe mempty . join++ handleError ex = do+ let displayMissing = "openDisplay" `T.isInfixOf` tshow ex+ if displayMissing+ then error "X display not available. Please start Xorg before running greenclip"+ else sayErrShow ex+++toRofiStr :: Text -> Text+toRofiStr = T.map (\c -> if c == '\n' || c == '\r' then '\xA0' else c)++fromRofiStr :: Text -> Text+fromRofiStr = T.map (\c -> if c == '\xA0' then '\n' else c)++printHistoryForRofi :: (MonadIO m, MonadReader Config m) => m ()+printHistoryForRofi = do+ history <- mappend <$> getHistory <*> getStaticHistory+ _ <- traverse (putStrLn . toRofiStr) history+ return ()++advertiseSelection :: Text -> IO ()+advertiseSelection = Clip.setClipboardString . T.unpack . fromRofiStr++getConfig :: IO Config+getConfig = do+ home <- Dir.getHomeDirectory+ let cfgPath = home </> ".config/greenclip.cfg"++ cfgStr <- (readFile cfgPath <&> T.strip . decodeUtf8) `catchAnyDeep` const mempty+ let cfg = fromMaybe (defaultConfig home) (readMay cfgStr)++ writeFile cfgPath (fromString $ show cfg)+ return cfg++ where+ defaultConfig home = Config 25 (home </> ".cache/greenclip.history") (home </> ".cache/greenclip.staticHistory") False+++parseArgs :: [Text] -> Command+parseArgs ("daemon":_) = DAEMON+parseArgs ["clear"] = CLEAR+parseArgs ["print"] = PRINT+parseArgs ["print", sel] = COPY sel+parseArgs _ = HELP++run :: Command -> IO ()+run cmd = do+ cfg <- getConfig+ case cmd of+ DAEMON -> runReaderT runDaemon cfg+ PRINT -> runReaderT printHistoryForRofi cfg+ CLEAR -> runReaderT (storeHistory mempty) cfg+ -- Should rename COPY into ADVERTISE but as greenclip is already used I don't want to break configs+ -- of other people+ COPY sel -> advertiseSelection sel+ HELP -> putStrLn $ "greenclip v1.3 -- Recyle your clipboard selections\n\n" <>+ "Available commands\n" <>+ "daemon: Spawn the daemon that will listen to selections\n" <>+ "print: Display all selections history\n" <>+ "clear: Clear history\n" <>+ "help: Display this message\n"++main :: IO ()+main = do+ displayPresent <- lookupEnv "DISPLAY"+ case displayPresent of+ Nothing -> putStrLn "X display not available. Please start Xorg before running greenclip"+ _ -> getArgs >>= run .parseArgs