diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,45 @@
+
+
+
+
+## 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 :**
+
+
+**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
+
diff --git a/greenclip.cabal b/greenclip.cabal
new file mode 100644
--- /dev/null
+++ b/greenclip.cabal
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -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
+