content: 
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE NoImplicitPrelude     #-}
  {-# LANGUAGE OverloadedStrings     #-}
  {-# LANGUAGE ScopedTypeVariables   #-}
  {-# LANGUAGE ViewPatterns          #-}
  
  
  module Main where
  
  import           Protolude             hiding (readFile, to, (<&>), (&), toS)
  import           Protolude.Conv        (toS)
  
  import           Control.Monad.Catch   (MonadCatch, catchAll)
  import qualified Crypto.Hash.MD5       as H
  import           Data.Binary           (decodeFile, encode)
  import qualified Data.ByteString       as B
  import qualified Data.ByteString.Base16 as BB
  import qualified Data.ByteString.Char8 as BC
  import           Data.List             (dropWhileEnd)
  import qualified Data.Text             as T
  import qualified Data.Text.Encoding    as TE
  import           Data.Vector           (Vector)
  import qualified Data.Vector           as V
  import           Lens.Micro
  import           Lens.Micro.Mtl    hiding ((.=))
  import qualified System.Directory      as Dir
  import           System.Posix.Files    (setFileMode)
  import           System.Environment    (lookupEnv)
  import           System.IO             (hClose, hGetContents)
  import           System.Timeout        (timeout)
  import           System.Wordexp.Simple (wordexp)
  --import           System.Posix.Temp     (mkdtemp)
  
  import Toml (TomlCodec, (.=))
  import qualified Toml
  
  import qualified Clipboard             as Clip
  
  
  data Command = DAEMON | PRINT | COPY Text | CLEAR | PRUNE FilePath | HELP deriving (Show, Read)
  
  data Config = Config
    { maxHistoryLength           :: Int
    , maxItemSizeBytes           :: Int
    , historyPath                :: Text
    , imageCachePath             :: Text
    , usePrimarySelectionAsInput :: Bool
    , blacklistedApps            :: [Text]
    , trimSpaceFromSelection     :: Bool
    , enableImageSupport         :: Bool
    , staticHistory              :: [Text]
    } deriving (Show, Read)
  
  configCodec :: TomlCodec Config
  configCodec = Config
      <$> Toml.int "max_history_length"  .= maxHistoryLength
      <*> Toml.int "max_selection_size_bytes" .= maxItemSizeBytes
      <*> Toml.text "history_file" .= historyPath
      <*> Toml.text "image_cache_directory" .= imageCachePath
      <*> Toml.bool "use_primary_selection_as_input" .= usePrimarySelectionAsInput
      <*> Toml.arrayOf Toml._Text  "blacklisted_applications" .= blacklistedApps
      <*> Toml.bool "trim_space_from_selection" .= trimSpaceFromSelection
      <*> Toml.bool "enable_image_support" .= enableImageSupport
      <*> Toml.arrayOf Toml._Text  "static_history" .= staticHistory
  
  
  type ClipHistory = Vector Clip.Selection
  
  readFile :: FilePath -> IO ByteString
  readFile filepath = bracket (openFile filepath ReadMode) hClose $ \h -> do
    str <- hGetContents h
    return $! toS str
  
  
  getHistory :: (MonadIO m, MonadReader Config m) => m ClipHistory
  getHistory = do
    storePath <- view $ to (toS . historyPath)
    liftIO $ (V.fromList <$> decodeFile storePath) `catchAll` const mempty
  
  
  getStaticHistory :: (MonadIO m, MonadReader Config m) => m ClipHistory
  getStaticHistory = do
    history <- view $ to (staticHistory)
    return . V.fromList $ Clip.Selection "greenclip" . Clip.UTF8 <$> history
  
  
  
  storeHistory :: (MonadIO m, MonadReader Config m) => ClipHistory -> m ()
  storeHistory history = do
    storePath <- view $ to (toS . historyPath)
    liftIO $ writeH storePath history
    where
      writeH storePath = B.writeFile storePath . toS . encode . V.toList
  
  
  pruneHistory :: (MonadIO m, MonadReader Config m) => FilePath -> m ()
  pruneHistory path = do
    targets <- liftIO $ BC.lines <$> readFile path
    history <- getHistory
    storeHistory $ V.filter (go targets) history
    where
      go ts (Clip.Selection _ (Clip.UTF8 x)) = hashText x `notElem` ts
      go _  _                                = False
      hashText = BB.encode . H.hash . TE.encodeUtf8
  
  
  appendToHistory :: (MonadIO m, MonadReader Config m) => Clip.Selection -> ClipHistory -> m (ClipHistory, ClipHistory)
  appendToHistory sel history' = do
    trimSelection <- view $ to trimSpaceFromSelection
    case sel of
      Clip.Selection appName (Clip.UTF8 txt) -> appendGeneric (if trimSelection then Clip.Selection appName (Clip.UTF8 (T.strip txt)) else sel) history'
      Clip.Selection _ (Clip.PNG bytes) -> appendImage Clip.PNG ".png" bytes
      Clip.Selection _ (Clip.JPEG bytes) -> appendImage Clip.JPEG ".jpeg" bytes
      Clip.Selection _ (Clip.BITMAP bytes) -> appendImage Clip.BITMAP ".bmp" bytes
  
  
    where
      appendImage imgCtr extension bytes = do
        cachePth <- view (to imageCachePath)
        let imgHash = show $ hash bytes
        let imgPath = toS $ cachePth <> "/" <> imgHash <> extension
        _ <- liftIO $ writeImage imgPath bytes
        appendGeneric (sel {Clip.selection = imgCtr $ toS imgHash}) history'
  
      writeImage path bytes = do
        fileExist <- Dir.doesFileExist path
        if fileExist
          then return False
          else B.writeFile path bytes >> setFileMode path 0o600 >> return True
  
      appendGeneric selection history =
        if maybe False (\sel' -> Clip.selection sel' == Clip.selection selection) (history V.!? 0)
          then return (history, mempty)
          else do
            maxLen <- view $ to maxHistoryLength
            return $ V.splitAt maxLen . V.cons selection $ V.filter (\ori -> Clip.selection ori /= Clip.selection selection) history
  
  
  setHistoryFilePermission :: (MonadIO m, MonadReader Config m) => m ()
  setHistoryFilePermission = do
    storePath <- view $ to (toS . historyPath)
    fileExist <- liftIO $ Dir.doesFileExist storePath
    when (not fileExist) (storeHistory mempty)
    liftIO $ setFileMode storePath 0o600
  
  prepareDirs :: (MonadIO m, MonadReader Config m) => m ()
  prepareDirs = do
    historyFile <- view $ to (T.unpack . historyPath)
    imgDir <- view $ to (T.unpack . imageCachePath)
    let dirs = [imgDir, dropWhileEnd (/= '/') historyFile]
    mapM_ (liftIO . Dir.createDirectoryIfMissing True) dirs
  
  runDaemon:: (MonadIO m, MonadCatch m, MonadReader Config m) => m ()
  runDaemon = prepareDirs >> setHistoryFilePermission >> (forever $ go `catchAll` handleError)
    where
      _0_5sec :: Int
      _0_5sec = 5 * 100000
  
      _5sec :: Int
      _5sec = 5000000
  
      go = do
        history <- getHistory
        usePrimary <- view $ to usePrimarySelectionAsInput
        enableImage <- view $ to enableImageSupport
        cfg <- ask
  
        liftIO $ bracket Clip.getXorgContext Clip.destroyXorgContext $ \x11Context -> do
          let getSelections = (getSelectionFrom (Clip.getClipboardSelection x11Context enableImage), Nothing)
                            : [(getSelectionFrom (Clip.getPrimarySelection x11Context enableImage), Nothing) | usePrimary]
          void $ runReaderT (innerloop getSelections history) cfg
  
      getSelection [] = return ([], Nothing)
      getSelection ((getSel, lastSel):getSels) = do
        selection <- liftIO getSel
        if fmap Clip.selection selection /= fmap Clip.selection lastSel
           then return ((getSel, selection) : getSels, selection)
           else getSelection getSels >>= \(e, sel) -> return ((getSel, lastSel) : e, sel)
  
      innerloop :: (MonadIO m, MonadReader Config m) => [(IO (Maybe Clip.Selection), Maybe Clip.Selection)] -> ClipHistory -> m ClipHistory
      innerloop getSelections history = do
        -- Get selection from enabled clipboards
        (getSelections', rawSelection) <- liftIO $ getSelection getSelections
  
        -- Do not store selection items above threshold size
        maxItemSize <- view (to maxItemSizeBytes)
        let sel = case rawSelection of
              Nothing -> Nothing
              Just selection -> if maxItemSize > 0 && Clip.selectionLength selection >= maxItemSize
                                then Nothing
                                else Just selection
               
        -- Do not use selection coming from blacklisted app
        liftIO $ when (isJust sel) (print (Clip.appName <$> sel))
        blacklist <- view (to blacklistedApps)
        let selection = sel >>= \s -> if isJust $ find (== Clip.appName s) blacklist
                                        then Nothing
                                        else Just s
  
        -- Append current selection to history and get back entries needed to be purged
        (history', toBePurged) <- maybe (return (history, mempty)) (`appendToHistory` history) selection
        traverse_ purgeSelection toBePurged
  
        -- backup on disk history if it as changed seen last backup
        when (isJust selection && history' /= history) (storeHistory history')
  
        -- Getting some rest
        liftIO $ threadDelay _0_5sec
        innerloop getSelections' history'
  
      getSelectionFrom :: IO (Maybe Clip.Selection) -> IO (Maybe Clip.Selection)
      getSelectionFrom = fmap join . timeout _5sec
  
      purgeSelection (Clip.Selection _ (Clip.PNG txt)) = purge (toS txt <> ".png")
      purgeSelection (Clip.Selection _ (Clip.JPEG txt)) = purge (toS txt <> ".jpeg")
      purgeSelection (Clip.Selection _ (Clip.BITMAP txt)) = purge (toS txt <> ".bmp")
      purgeSelection _ = return ()
  
      purge path = do
        cachePth <- view (to imageCachePath)
        liftIO $ Dir.removeFile (toS $ cachePth <> "/" <> path) `catchAll` const mempty
  
      handleError ex = do
        let displayMissing = "openDisplay" `T.isInfixOf` show ex
        if displayMissing
        then panic "X display not available. Please start Xorg before running greenclip"
        else print ex
        liftIO $ threadDelay _0_5sec
  
  
  toRofiStr :: Clip.Selection -> Text
  toRofiStr (Clip.Selection _ (Clip.UTF8 txt)) = T.map (\c -> if c == '\n' || c == '\r' then '\xA0' else c) txt
  toRofiStr (Clip.Selection appName (Clip.PNG txt)) = "image/png " <> appName <> " " <> toS txt
  toRofiStr (Clip.Selection appName (Clip.JPEG txt)) = "image/jpeg " <> appName <> " " <> toS txt
  toRofiStr (Clip.Selection appName (Clip.BITMAP txt)) = "image/bmp " <> appName <> " " <> toS txt
  
  fromRofiStr :: Text -> Text -> IO Clip.Selection
  fromRofiStr cachePth txt@(T.isPrefixOf "image/png " -> True) = B.readFile (toS $ cachePth <> "/" <> getHash txt <> ".png") <&> Clip.Selection "greenclip" . Clip.PNG
  fromRofiStr cachePth txt@(T.isPrefixOf "image/jpeg " -> True) = B.readFile (toS $ cachePth <> "/" <> getHash txt <> ".jpeg") <&> Clip.Selection "greenclip" . Clip.JPEG
  fromRofiStr cachePth txt@(T.isPrefixOf "image/bmp " -> True) = B.readFile (toS $ cachePth <> "/" <> getHash txt <> ".bmp") <&> Clip.Selection "greenclip" . Clip.BITMAP
  fromRofiStr _ txt = return $ Clip.Selection "greenclip" (Clip.UTF8 (T.map (\c -> if c == '\xA0' then '\n' else c) txt))
  
  getHash :: Text -> Text
  getHash = fromMaybe mempty . lastMay . T.split (== ' ')
  
  
  printHistoryForRofi :: (MonadIO m, MonadReader Config m) => m ()
  printHistoryForRofi = do
    history <- mappend <$> getHistory <*> getStaticHistory
    _ <- traverse (putStrLn . toRofiStr) history
    return ()
  
  
  advertiseSelection :: (MonadIO m, MonadReader Config m) => Text -> m ()
  advertiseSelection txt = do
    cachePth <- view (to imageCachePath)
    selection <- liftIO $ fromRofiStr cachePth txt
    liftIO $ Clip.setClipboardSelection selection
  
  
  getConfig :: IO Config
  getConfig = do
    home <- Dir.getHomeDirectory
    let configPath = home <> "/.config/greenclip.toml"
    
    configExist <- Dir.doesFileExist configPath
    when (not configExist) $ do 
      config <- Toml.encode (Toml.table configCodec "greenclip") <$> defaultConfig
      writeFile configPath config
      return ()
    
    tomlRes <- Toml.decodeFileEither (Toml.table configCodec "greenclip") configPath
    when (isLeft tomlRes) $ do
      die . toS $  "Error parsing the config file at " <> (show configPath) <> "\n" <> Toml.prettyTomlDecodeErrors (fromLeft mempty tomlRes)
    
    let cfg = fromRight (Config 50 0 "" "" False [] True True []) tomlRes 
    
    -- Replace $HOME|~|*... in config path
    cfg <- do
      imgCachePath <- wordexp . toS $ imageCachePath cfg
      historyP <- wordexp . toS $ historyPath cfg 
      return $ cfg { imageCachePath = (toS $ headDef "" imgCachePath), historyPath = (toS $ headDef "" historyP)}
      
    -- if it ends with / we don't create a temp directory
    -- user is responsible for it
    -- cfg <- if (lastDef ' ' (toS $ imageCachePath cfg) /= '/')
    --    then do
    --      dirPath <- mkdtemp $ (toS $ imageCachePath cfg)
    --      return $ cfg { imageCachePath = toS dirPath }
    --    else return cfg
       
    return cfg
  
    where
      defaultConfig = do 
        homeDir <- toS . fromMaybe mempty . listToMaybe <$> wordexp "~/"
        return $ Config 50 0 (homeDir <> ".cache/greenclip.history") "/tmp/greenclip" False [] True True 
          ["Greenclip has been updated to v4.1, update your new config file at ~/.config/greenclip.toml"]
  
  
  parseArgs :: [Text] -> Command
  parseArgs ("daemon":_)   = DAEMON
  parseArgs ["clear"]      = CLEAR
  parseArgs ["prune", p]   = PRUNE $ T.unpack p
  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
      PRUNE p  -> runReaderT (pruneHistory p) cfg
      -- Should rename COPY into ADVERTISE but as greenclip is already used I don't want to break configs
      -- of other people
      COPY sel -> runReaderT (advertiseSelection sel) cfg
      HELP     -> putText $ "greenclip v4.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" <>
                            "prune FILE: Remove selections in list of md5 hashes in FILE\n" <>
                            "clear:  Clear history\n" <>
                            "help:   Display this message\n"
  
  main :: IO ()
  main = do
    displayPresent <- lookupEnv "DISPLAY"
    case displayPresent of
      Nothing -> putText "X display not available. Please start Xorg before running greenclip"
      _       -> getArgs >>= run . parseArgs . fmap toS
  