content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE OverloadedStrings #-}
  -----------------------------------------------------------------------------
  --
  -- Module      :  IDE.TextEditor.Yi
  -- Copyright   :  2007-2013 Juergen Nicklisch-Franken, Hamish Mackenzie
  -- License     :  GPL Nothing
  --
  -- Maintainer  :  maintainer@leksah.org
  -- Stability   :  provisional
  -- Portability :
  --
  -- |
  --
  -----------------------------------------------------------------------------
  
  module IDE.TextEditor.Yi (
      Yi(..)
  
  #ifdef LEKSAH_WITH_YI
    , TextEditor(..)
    , EditorBuffer(..)
    , EditorView(..)
    , EditorIter(..)
    , EditorMark(..)
    , EditorTag(..)
    , EditorTagTable(..)
  
    , newYiBuffer
  #endif
  ) where
  
  import Prelude ()
  import Prelude.Compat
  import Data.Typeable (Typeable)
  
  #ifdef LEKSAH_WITH_YI
  import Data.Text (Text)
  import qualified Data.Text as T (pack, unpack)
  import GI.Gtk
         (noWidget, getCurrentEventTime, menuPopup, menuAttachToWidget,
          menuNew, onWidgetPopupMenu, onWidgetKeyReleaseEvent,
          onWidgetLeaveNotifyEvent, onWidgetMotionNotifyEvent,
          onWidgetKeyPressEvent, onWidgetButtonReleaseEvent,
          onWidgetButtonPressEvent, widgetAddEvents, afterWidgetFocusInEvent,
          widgetGrabFocus, toWidget, widgetGetWindow)
  import GI.Gdk
         (getEventButtonState)
  import Graphics.UI.Frame.Rectangle
         (Rectangle(..), newRectangle)
  import Data.GI.Base.Attributes (AttrOp(..))
  import GI.Pango (layoutSetFontDescription)
  import Yi (nelemsB, readAtB, moveB)
  import Yi.Buffer.TextUnit (TextUnit(..))
  import GI.Gdk.Flags (ModifierType(..), EventMask(..))
  import Control.Monad (void)
  import qualified Yi.Rope as R (head)
  import IDE.Core.Types (MonadIDE(..))
  import Data.GI.Base.BasicConversions (gflagsToWord)
  
  import IDE.TextEditor.Class (TextEditor(..))
  import IDE.Core.Types (IDEM)
  import IDE.Core.State (liftYi, onIDE, reflectIDE, liftYiControl)
  import qualified Yi.UI.Pango.Control as Yi
         (getBuffer, setText, newView, getText, newBuffer)
  import Yi.UI.Pango.Control
         (Control(..), View(..), iterFBufRef, Iter(..), fBufRef, Buffer(..),
          setBufferMode)
  import Yi
         (moveToColB, gotoLn, atSol, atEof, atSof, curCol, curLn, readLnB,
          nextWordB, moveToEol, rightB, rightN,
          unitWord, atBoundaryB, moveToSol, prevWordB, leftB, readB,
          doUntilB_, prevPointB, Mode, modifyMode, insertingA, undoB,
          markSavedB, setSelectRegionB, redoB, markPointA, insertNAt,
          regionIsEmpty, regionEnd, regionStart, selMark, isUnchangedBuffer,
          Point(..), MarkValue(..), lineOf, pointOfLineColB,
          askMarks, insMark, sizeB, getRawestSelectRegionB, mkRegion,
          deleteRegionB, newMarkB, Mark, pointB, moveTo, savingPointB, Point,
          withGivenBuffer, withEditor, BufferM, BufferRef, Mode(..),
          IndentSettings(..), BufferId(..))
  import qualified Yi.Rope as Yi (length, fromText)
  import Control.Applicative ((<$>))
  import Yi.Keymap.Cua (paste, cut, copy)
  import Yi.Buffer.Basic (Direction(..))
  import Control.Monad.State.Class (gets)
  import Control.Monad (unless)
  import Control.Monad.IO.Class (MonadIO(..))
  import Data.Time (getCurrentTime)
  import IDE.Utils.GUIUtils (fontDescription)
  import Control.Monad.Reader.Class (MonadReader(..))
  import Graphics.UI.Editor.Basics (Connection(..))
  import Control.Monad.Trans.Class (MonadTrans(..))
  import Control.Lens (use)
  #endif
  
  data Yi = Yi deriving( Typeable, Show )
  
  #ifdef LEKSAH_WITH_YI
  newYiBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer Yi)
  newYiBuffer mbFilename contents = do
      liftYiControl $ do
          let (filename, id) = case mbFilename of
                                  Just fn -> (fn, FileBuffer fn)
                                  Nothing -> ("Unknown.hs", MemBuffer "*leksah*")
          buffer <- Yi.newBuffer id $ Yi.fromText contents
          setBufferMode filename buffer
          return $ YiBuffer buffer
  
  withYiBuffer' :: BufferRef -> BufferM a -> IDEM a
  withYiBuffer' b f = liftYi $ withEditor $ withGivenBuffer b f
  
  withYiBuffer :: Buffer -> BufferM a -> IDEM a
  withYiBuffer b f = withYiBuffer' (fBufRef b) f
  
  mkYiIter' :: BufferRef -> Point -> EditorIter Yi
  mkYiIter' b p = YiIter $ Iter b p
  
  mkYiIter :: Buffer -> Point -> EditorIter Yi
  mkYiIter b p = mkYiIter' (fBufRef b) p
  
  withYiIter :: Iter -> BufferM a -> IDEM a
  withYiIter (Iter b p) f = withYiBuffer' b $ do
      savingPointB $ do
          moveTo p
          f
  
  transformYiIter' :: Iter -> BufferM Point -> IDEM (EditorIter Yi)
  transformYiIter' i f = mkYiIter' (iterFBufRef i) <$> withYiIter i f
  
  transformYiIter :: Iter -> BufferM a -> IDEM (EditorIter Yi)
  transformYiIter i f = transformYiIter' i (f >> pointB)
  
  tryTransformYiIter' :: Iter -> BufferM Point -> IDEM (Maybe (EditorIter Yi))
  tryTransformYiIter' i@(Iter b p) f = withYiIter i $ do
      newPoint <- f
      if p == newPoint
          then return Nothing
          else return . Just $ mkYiIter' b newPoint
  
  tryTransformYiIter :: Iter -> BufferM a -> IDEM (Maybe (EditorIter Yi))
  tryTransformYiIter i f = tryTransformYiIter' i (f >> pointB)
  
  iterFromYiBuffer' :: BufferRef -> BufferM Point -> IDEM (EditorIter Yi)
  iterFromYiBuffer' b f = mkYiIter' b <$> withYiBuffer' b f
  
  iterFromYiBuffer :: Buffer -> BufferM Point -> IDEM (EditorIter Yi)
  iterFromYiBuffer b f = iterFromYiBuffer' (fBufRef b) f
  
  instance TextEditor Yi where
      data EditorBuffer Yi = YiBuffer Buffer
      data EditorView Yi = YiView View
      data EditorMark Yi = YiMark Mark
      data EditorIter Yi = YiIter Iter
      data EditorTagTable Yi = YiTagTable
      data EditorTag Yi = YiTag
  
      newBuffer = newYiBuffer
      applyTagByName (YiBuffer fb) name (YiIter first) (YiIter last) = return () -- TODO
      beginNotUndoableAction (YiBuffer fb) = return () -- TODO
      beginUserAction (YiBuffer fb) = return () -- TODO
      canRedo (YiBuffer fb) = return True -- TODO
      canUndo (YiBuffer fb) = return True -- TODO
      copyClipboard (YiBuffer fb) _ = liftYi $ withEditor $ copy
      createMark (YiView b) _name (YiIter (Iter _ p)) _toolTip = void . withYiBuffer (Yi.getBuffer b) $
          YiMark <$> newMarkB (MarkValue p Backward)
      cutClipboard (YiBuffer fb) clipboard defaultEditable = liftYi $ withEditor $ cut
      delete (YiBuffer b) (YiIter (Iter _ first)) (YiIter (Iter _ last)) =
          withYiBuffer b $ deleteRegionB $ mkRegion first last
      deleteSelection (YiBuffer b) = withYiBuffer b $ do
          region <- getRawestSelectRegionB
          deleteRegionB region -- TODO support flags
      endNotUndoableAction (YiBuffer fb) = return () -- TODO
      endUserAction (YiBuffer fb) = return () -- TODO
      getEndIter (YiBuffer b) = iterFromYiBuffer b sizeB
      getInsertMark (YiBuffer b) = YiMark <$> (withYiBuffer b $ insMark <$> askMarks)
      getIterAtLine (YiBuffer b) line = iterFromYiBuffer b $ pointOfLineColB line 1
      getIterAtMark (YiBuffer b) (YiMark m) = iterFromYiBuffer b $ (use . markPointA) m
      getIterAtOffset (YiBuffer b) offset = return $ mkYiIter b $ Point offset
      getLineCount (YiBuffer b) = withYiBuffer b $ sizeB >>= lineOf
      getModified (YiBuffer b) = not <$> (withYiBuffer b $ gets isUnchangedBuffer)
      getSelectionBoundMark (YiBuffer b) = YiMark . selMark <$> (withYiBuffer b $ askMarks)
      getSelectionBounds (YiBuffer b) = withYiBuffer b $ do
          region <- getRawestSelectRegionB
          return (mkYiIter b (regionStart region),
                  mkYiIter b (regionEnd region))
      getInsertIter (YiBuffer b) = withYiBuffer b $ do
          insertMark <- insMark <$> askMarks
          mkYiIter b <$> (use . markPointA) insertMark
      getSlice (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $
          Yi.getText b first last
      getStartIter (YiBuffer b) = return $ mkYiIter b $ Point 0
      getTagTable (YiBuffer b) = return YiTagTable -- TODO
      getText (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $
          Yi.getText b first last
      hasSelection (YiBuffer b) = withYiBuffer b $ do
          region <- getRawestSelectRegionB
          return $ not $ regionIsEmpty region
      insert (YiBuffer b) (YiIter (Iter _ p)) text = withYiBuffer b $ insertNAt (Yi.fromText text) p
      newView (YiBuffer b) mbFontString = do
          fd <- fontDescription mbFontString
          v <- liftYiControl $ Yi.newView b fd
          return (YiView v, scrollWin v)
      pasteClipboard (YiBuffer b) clipboard (YiIter (Iter _ p)) defaultEditable = liftYi $ withEditor $ paste
      placeCursor (YiBuffer b) (YiIter (Iter _ p)) = withYiBuffer b $ moveTo p
      redo (YiBuffer b) = withYiBuffer b redoB
      removeTagByName (YiBuffer b) name = return () -- TODO
      selectRange (YiBuffer b) (YiIter (Iter _ first)) (YiIter (Iter _ last)) = withYiBuffer b $
          setSelectRegionB $ mkRegion first last
      setModified (YiBuffer b) modified = unless modified $ do
          now <- liftIO $ getCurrentTime
          withYiBuffer b $ markSavedB now
      setStyle (YiBuffer b) mbStyle = return () -- TODO
      setText (YiBuffer b) text = liftYiControl $ Yi.setText b (Yi.fromText text)
      undo (YiBuffer b) =  withYiBuffer b undoB
      bufferToWindowCoords (YiView v) point = return point -- TODO
      drawTabs (YiView _) = return () -- TODO
      getBuffer (YiView v) = return $ YiBuffer $ Yi.getBuffer v
      getWindow (YiView v) = widgetGetWindow (drawArea v)
      getIterAtLocation (YiView View{viewFBufRef = b}) x y = return $ mkYiIter' b $ Point 0 -- TODO
      getIterLocation (YiView v) (YiIter i) = newRectangle 0 0 0 0 -- TODO
      getOverwrite (YiView View{viewFBufRef = b}) = withYiBuffer' b $ not <$> use insertingA
      getScrolledWindow (YiView v) = return $ scrollWin v
      getEditorWidget (YiView v) = liftIO . toWidget $ drawArea v
      grabFocus (YiView View{drawArea = da}) = widgetGrabFocus da
      scrollToMark (YiView v) (YiMark m) withMargin mbAlign = return () -- TODO
      scrollToIter (YiView v) (YiIter i) withMargin mbAlign = return () -- TODO
      setFont (YiView v) mbFontString = do
          fd <- fontDescription mbFontString
          layoutSetFontDescription (layout v) (Just fd)
      setIndentWidth (YiView View{viewFBufRef = b}) width =
          withYiBuffer' b $ modifyMode $
              \ (mode@Mode{modeIndentSettings = mis}) ->
                  mode{modeIndentSettings = mis{shiftWidth = width}}
      setWrapMode (YiView View{viewFBufRef = b}) width = return ()
      setRightMargin (YiView v) mbRightMargin = return () -- TODO
      setShowLineNumbers (YiView v) show = return () -- TODO
      setTabWidth (YiView View{viewFBufRef = b}) width =
          withYiBuffer' b $ modifyMode $
              \ (mode@Mode{modeIndentSettings = mis}) ->
                  mode{modeIndentSettings = mis{tabSize = width}}
  
      backwardCharC (YiIter i) = transformYiIter' i prevPointB
      backwardFindCharC (YiIter i) pred mbLimit = tryTransformYiIter i $
          doUntilB_ (pred <$> readB) leftB
      backwardWordStartC (YiIter i@(Iter b p)) = withYiIter i $ do
          prevWordB
          newPoint <- pointB
          if p == newPoint
              then return Nothing
              else return . Just $ mkYiIter' b newPoint
      backwardToLineStartC (YiIter i) = transformYiIter i moveToSol
      endsWord (YiIter i) = withYiIter i $ do
          atBoundaryB unitWord Forward
      forwardCharC i = forwardCharsC i 1
      forwardCharsC (YiIter i) n = transformYiIter i $ rightN n
      forwardFindCharC (YiIter i) pred mbLimit = tryTransformYiIter i $
          doUntilB_ (pred <$> readB) rightB
      forwardSearch (YiIter i) str pred mbLimit = return Nothing -- TODO
      forwardToLineEndC (YiIter i) = transformYiIter i moveToEol
      forwardWordEndC (YiIter i@(Iter b p)) = withYiIter i $ do
          nextWordB
          newPoint <- pointB
          if p == newPoint
              then return Nothing
              else return . Just $ mkYiIter' b newPoint
      getChar (YiIter (Iter b p)) = withYiBuffer' b $ R.head <$> nelemsB 1 p
      getCharsInLine (YiIter i) = withYiIter i $ Yi.length <$> readLnB
      getLine (YiIter i) = withYiIter i curLn
      getLineOffset (YiIter i) = withYiIter i curCol
      getOffset (YiIter (Iter _ (Point o))) = return o
      isStart (YiIter i) = withYiIter i atSof
      isEnd (YiIter i) = withYiIter i atEof
      iterEqual (YiIter (Iter _ p1)) (YiIter (Iter _ p2)) = return $ p1 == p2
      startsLine (YiIter i) = withYiIter i atSol
      startsWord (YiIter i) = withYiIter i atSol -- TODO
      atEnd (YiIter (Iter b _)) = iterFromYiBuffer' b sizeB
      atLine (YiIter i) line = transformYiIter i $ gotoLn line
      atLineOffset (YiIter i) column = transformYiIter i $ moveToColB column
      atOffset (YiIter (Iter b _)) offset = return $ YiIter $ Iter b (Point offset)
      atStart (YiIter (Iter b _)) = return $ mkYiIter' b $ Point 0
      newTag (YiTagTable) name = return YiTag -- TODO
      lookupTag (YiTagTable) name = return Nothing -- TODO
      background (YiTag) color = return () -- TODO
      underline (YiTag) value = return () -- TODO
      afterFocusIn (YiView v) f = do
          ideR <- ask
          id1 <- onIDE afterWidgetFocusInEvent (drawArea v) $ liftIDE f >> return True
          return [id1]
      afterModifiedChanged (YiBuffer b) f = return [] -- TODO
      afterMoveCursor (YiView v) f = return [] -- TODO
      afterToggleOverwrite (YiView v) f = return [] -- TODO
      onButtonPress (YiView v) f = do
          id1 <- onIDE onWidgetButtonPressEvent (drawArea v) f
          return [id1]
      onButtonRelease (YiView v) f = do
          id1 <- onIDE onWidgetButtonReleaseEvent (drawArea v) f
          return [id1]
      onCompletion (YiView v) start cancel = return [] -- TODO
      onKeyPress (YiView v) f = do
          id1 <- onIDE onWidgetKeyPressEvent (drawArea v) f
          return [id1]
      onMotionNotify (YiView v) f = do
          id1 <- onIDE onWidgetMotionNotifyEvent (drawArea v) f
          return [id1]
      onLeaveNotify (YiView v) f = do
          id1 <- onIDE onWidgetLeaveNotifyEvent (drawArea v) f
          return [id1]
      onKeyRelease (YiView v) f = do
          id1 <- onIDE onWidgetKeyReleaseEvent (drawArea v) f
          return [id1]
      onLookupInfo (YiView v) f = do
          widgetAddEvents (drawArea v) (gflagsToWord [EventMaskButtonReleaseMask])
          id1 <- onIDE onWidgetButtonReleaseEvent (drawArea v) $ do
              e <- lift ask
              mod <- getEventButtonState e
              case mod of
                  [ModifierTypeControlMask] -> f >> return True
                  _                         -> return False
          return [id1]
      onMotionNotifyEvent (YiView v) f = return [] -- TODO
      onPopulatePopup (YiView v) f = do
          ideR <- ask
          liftIO $ do
              id1 <- ConnectC (drawArea v) <$> onWidgetPopupMenu (drawArea v) (do
                   menu <- menuNew
                   menuAttachToWidget menu (drawArea v) Nothing
                   reflectIDE (f menu) ideR
                   menuPopup menu noWidget noWidget Nothing 0 =<< getCurrentEventTime
                   return True)
              return [id1]
      onSelectionChanged (YiBuffer b) handler = return [] -- TODO
      setEditable _ _ = return () -- TODO
  #endif
  
  