-- |
-- Module      : Hoodle.ModelAction.Clipboard
  Copyright    : ( c ) 2011 - 2013    
--
-- License     : BSD3
  Maintainer   :     <  >
-- Stability   : experimental
  Portability : GHC
--
-- Clipboard io actions
module Hoodle.ModelAction.Clipboard where

import Control.Lens (view)
import Control.Monad.Trans (liftIO)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C8
import Data.Hoodle.Simple (Item)
import qualified Data.Serialize as Se
import qualified Graphics.UI.Gtk as Gtk
import Hoodle.ModelAction.Select (togglePaste)
import Hoodle.Script.Hook (afterUpdateClipboardHook)
import Hoodle.Type.Event
  ( AllEvent (UsrEv),
    UserEvent (GotClipboardContent),
  )
import Hoodle.Type.HoodleState
  ( HoodleState,
    gtkUIManager,
    hookSet,
  )

-- |
updateClipboard :: HoodleState -> [Item] -> IO HoodleState
updateClipboard xstate itms
  | null itms = return xstate
  | otherwise = do
    let ui = view gtkUIManager xstate
    hdltag <- Gtk.atomNew "hoodle"
    clipbd <- Gtk.clipboardGet hdltag
    let bstr = C8.unpack . B64.encode . Se.encode $ itms
    Gtk.clipboardSetText clipbd bstr
    togglePaste ui True
    case view hookSet xstate of
      Nothing -> return ()
      Just hset -> case afterUpdateClipboardHook hset of
        Nothing -> return ()
        Just uchook -> liftIO $ uchook itms
    return xstate

-- |
callback4Clip :: (AllEvent -> IO ()) -> Maybe String -> IO ()
callback4Clip callbk Nothing = callbk (UsrEv (GotClipboardContent Nothing))
callback4Clip callbk (Just str) = do
  let r = do
        let bstr = C8.pack str
        bstr' <- B64.decode bstr
        Se.decode bstr'
  case r of
    Left _err -> callbk (UsrEv (GotClipboardContent Nothing))
    Right cnt -> callbk (UsrEv (GotClipboardContent (Just cnt)))

 |
 Module      : Hoodle.ModelAction.Clipboard

 License     : BSD3
 Stability   : experimental

 Clipboard io actions
 |
 |
  Copyright    : ( c ) 2011 - 2013    
  Maintainer   :     <  >
  Portability : GHC
module Hoodle.ModelAction.Clipboard where

import Control.Lens (view)
import Control.Monad.Trans (liftIO)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C8
import Data.Hoodle.Simple (Item)
import qualified Data.Serialize as Se
import qualified Graphics.UI.Gtk as Gtk
import Hoodle.ModelAction.Select (togglePaste)
import Hoodle.Script.Hook (afterUpdateClipboardHook)
import Hoodle.Type.Event
  ( AllEvent (UsrEv),
    UserEvent (GotClipboardContent),
  )
import Hoodle.Type.HoodleState
  ( HoodleState,
    gtkUIManager,
    hookSet,
  )

updateClipboard :: HoodleState -> [Item] -> IO HoodleState
updateClipboard xstate itms
  | null itms = return xstate
  | otherwise = do
    let ui = view gtkUIManager xstate
    hdltag <- Gtk.atomNew "hoodle"
    clipbd <- Gtk.clipboardGet hdltag
    let bstr = C8.unpack . B64.encode . Se.encode $ itms
    Gtk.clipboardSetText clipbd bstr
    togglePaste ui True
    case view hookSet xstate of
      Nothing -> return ()
      Just hset -> case afterUpdateClipboardHook hset of
        Nothing -> return ()
        Just uchook -> liftIO $ uchook itms
    return xstate

callback4Clip :: (AllEvent -> IO ()) -> Maybe String -> IO ()
callback4Clip callbk Nothing = callbk (UsrEv (GotClipboardContent Nothing))
callback4Clip callbk (Just str) = do
  let r = do
        let bstr = C8.pack str
        bstr' <- B64.decode bstr
        Se.decode bstr'
  case r of
    Left _err -> callbk (UsrEv (GotClipboardContent Nothing))
    Right cnt -> callbk (UsrEv (GotClipboardContent (Just cnt)))
