packages feed

spade-0.1.0.6: src/UI/Widgets/Editor.hs

module UI.Widgets.Editor where

import Control.Monad.Loops (iterateUntilM)
import Data.List as DL hiding (lines)
import Data.Maybe
import Data.Proxy (Proxy(..))
import Data.Text as T
import Prelude hiding (lines)
import System.Console.ANSI (Color(..))
import Text.Printf

import DiffRender.DiffRender
import Common
import Highlighter.Highlighter
import UI.Widgets.Common
import UI.Widgets.Editor.Cursor

data EditorMode = InsertMode | ReplaceMode
  deriving (Eq, Show)

data SomeTokenStream where
  SomeTokenStream :: (Show a, Highlightable a) => IO [a] -> SomeTokenStream

data SelectionInfo = SelectionInfo
  { slStart :: Int
  , slRangeStart :: Int
  , slRangeEnd :: Int
  }

selectionToTuple :: SelectionInfo -> (Int, Int)
selectionToTuple SelectionInfo {..} = (slRangeStart, slRangeEnd)

data EditorWidget = EditorWidget
  { ewContent            :: Text
  , ewDim                :: Dimensions
  , ewVisibility         :: Bool
  , ewPos                :: ScreenPos
  , ewCursor             :: Int -- Cursor position offset into content. Starts at 0
  , ewDebugLocation      :: Maybe Location
  , ewParseErrorLocation :: Maybe Location
  , ewWordWrap           :: Bool
  , eweHasFocus          :: Bool
  , ewScrollOffset       :: Int
  , ewInsertMode         :: EditorMode
  , ewTokenStream        :: Maybe SomeTokenStream
  , ewAutocompleteWidget :: Maybe SomeWidgetRef
  , ewAutocompleteSuggestions :: (forall m. MonadIO m => Text -> m [(Text, Text)])
  , ewReadOnly           :: Bool
  , ewCursorInfo         :: CursorInfo -- Cursor info (location relative to the begining of text)
  , ewSelection          :: Maybe SelectionInfo
  , ewShowVirtualCursor  :: Bool
  , ewParams             :: EditorParams
  , ewCursorLine         :: Int -- Line on which the cursor is currently. 1 based
  }

data EditorParams = EditorParams
  { epGutterSize         :: Int
  , epLinenumberWidth    :: Int
  , epLinenumberRightPad :: Int
  , epBorder             :: Bool
  , epLineNos            :: Bool
  } deriving Show

defaultEp :: EditorParams
defaultEp = EditorParams 1 4 0 True True

instance Moveable EditorWidget where
  getPos ref = ewPos <$> readWRef ref
  move ref pos = modifyWRef ref (\ew -> ew { ewPos = pos })
  getDim ref = ewDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\low -> low { ewDim = cb $ ewDim low })

instance Widget EditorWidget where
  hasCapability (KeyInputCap _) = Just Dict
  hasCapability (DrawableCap _) = Just Dict
  hasCapability (MoveableCap _) = Just Dict
  hasCapability _               = Nothing

getTextPaddingAndSoftLineLength :: Dimensions -> EditorParams -> (Int, Int)
getTextPaddingAndSoftLineLength d EditorParams {..} = let
  linenumberWidth' = if epLineNos then epLinenumberWidth else 0
  linenumberRightPad' = if epLineNos then epLinenumberRightPad else 0
  epBorderSize = if epBorder then 1 else 0
  textPadding = epBorderSize + epGutterSize + linenumberWidth' + linenumberRightPad'
  softLineLength = (diW d) - textPadding - epBorderSize
  in (textPadding, softLineLength)

getContentStart :: EditorParams -> ScreenPos
getContentStart EditorParams {..} = let
  epBorderSize = if epBorder then 1 else 0
  in ScreenPos (epBorderSize + epGutterSize) epBorderSize

getTextContentStart :: Dimensions -> EditorParams -> ScreenPos
getTextContentStart d ep = let
  (tp, _) = getTextPaddingAndSoftLineLength d ep
  epBorderSize = if epBorder ep then 1 else 0
  gutterBorder = epBorderSize + epGutterSize ep
  in addSp (ScreenPos (tp - gutterBorder) 0) (getContentStart ep)

resetCursor :: EditorWidget -> EditorWidget
resetCursor ew = ew { ewScrollOffset = 0, ewCursor = 0, ewCursorInfo = (ScreenPos 0 0, Bar) }

wrapInSpace :: Text -> Text
wrapInSpace x = " " <> x <> " "

instance Drawable EditorWidget where
  setVisibility ref v = modifyWRefM ref (\b -> do
    case ewAutocompleteWidget b of
      Just (SomeWidgetRef acRef) -> withCapability (DrawableCap acRef) $ do
        setVisibility acRef False
      _ -> pure ()
    pure $ b { ewVisibility = v })
  getVisibility ref = ewVisibility <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    draw' w

    where
      draw' w = do
        let epBorderSize = if (epBorder $ ewParams w) then 1 else 0
        if ((diH $ ewDim w) > 2  && (epBorder $ ewParams w))
            then drawBorderBox (ewPos w) (ewDim w) else pass
        let (_, softLineLength) = getTextPaddingAndSoftLineLength (ewDim w) params

        let content = ewContent w
        let cursorLine = ewCursorLine w
        let contentHeight = (diH $ ewDim w) - (2 * epBorderSize)

        let mDlocation = ewDebugLocation w
        let mElocation = ewParseErrorLocation w
        let mSelection = selectionToTuple <$> ewSelection w
        let mCursorLoc = if (ewShowVirtualCursor w) then Just (ewCursor w) else Nothing
        let contentStartPos = addSp (getContentStart params) (ewPos w)
        case ewTokenStream w of
          Nothing ->
            void $ iterateUntilM isNothing
              (printOneLine @Text params mCursorLoc (epLineNos params) cursorLine mSelection mElocation mDlocation (softLineLength, contentHeight) (ewScrollOffset w) contentStartPos) $ Just (content, 1, 0, 0, [])
          Just (SomeTokenStream (readTokens :: IO [tokenstream])) -> do
            tokens <- liftIO readTokens
            void $ iterateUntilM isNothing
              (printOneLine @tokenstream params mCursorLoc (epLineNos params) cursorLine mSelection mElocation mDlocation (softLineLength, contentHeight) (ewScrollOffset w) contentStartPos) $ Just (content, 1, 0, 0, tokens)

        getCursorInfo ref >>= \case
          Nothing -> pure ()
          Just (cl, _) -> do
            case (ewAutocompleteWidget w) of
              Just (SomeWidgetRef a) ->
                withCapability (DrawableCap a) $ do
                  getVisibility a >>= \case
                    False -> pure ()
                    True -> do
                      withCapability (MoveableCap a) $ do
                        Dimensions bx by <- getScreenBounds
                        Dimensions ax ay <- getDim a
                        let
                          newAcPos = moveDown 1 cl
                          acEndY = sY $ moveDown ay newAcPos
                          acEndX = sX $ moveRight ax newAcPos
                          rightOf = acEndX - bx
                          bottomOf = acEndY - by

                          bottomOfFixed = if bottomOf > 0
                            then moveUp (ay+1) newAcPos
                            else newAcPos

                          rightOfFixed = if rightOf > 0
                            then moveLeft rightOf bottomOfFixed
                            else bottomOfFixed
                        move a rightOfFixed
              Nothing -> pure ()
        where
          params = ewParams w

printOneLine
  :: forall a m. (Show a, WidgetC m, Highlightable a)
  => EditorParams
  -> Maybe Int
  -> Bool
  -> Int
  -> Maybe (Int, Int)
  -> Maybe Location
  -> Maybe Location
  -> (Int, Int)
  -> Int
  -> ScreenPos
  -> Maybe (Text, Int, Int, Int, [a])
  -> m (Maybe (Text, Int, Int, Int, [a]))
printOneLine _ _ _ _ _ _ _ _ _ _ Nothing = pure Nothing
printOneLine params@(EditorParams {..}) mCursorLoc showLineNos cursorLine selection errorLocation debugLocation (width, height) scrollOffset startPos (Just (cnt, lnNo, realoffset, hoffset, tokenStack)) = do
   -- Take until next newline
   let hl = T.takeWhile (/= '\n') cnt
   let offset = realoffset - scrollOffset
   case debugLocation of
     Just dLocation -> do
       when (lnNo == lcLine dLocation && ((lnNo - scrollOffset) < height) && ((lnNo - scrollOffset) > 0)) $ do
         wSetCursor $ moveLeft 1 $ moveDown offset startPos
         csPutText (colorTextFg Green ">")
     Nothing -> pure ()
   case errorLocation of
     Just eLocation -> do
       when (lnNo == lcLine eLocation && ((lnNo - scrollOffset) < height) && ((lnNo - scrollOffset) > 0)) $ do
         wSetCursor $ moveLeft 1 $ moveDown offset startPos
         csPutText (colorText White Red "X")
     Nothing -> pure ()
   wSetCursor $ moveDown offset startPos
   when (showLineNos && isPrintableArea offset height) $ do
     let formatstr = "%" <> show linenumberWidth' <> "d"
     if lnNo == cursorLine
       then csPutText $ colorText White Black $ pack $ printf formatstr lnNo
       else csPutText $ Plain $ pack $ printf formatstr lnNo
   let ct = T.chunksOf width hl
   newTokenStack <- foldM (\stk x -> printOneSoftLine params startPos debugLocation selection errorLocation mCursorLoc width height hoffset offset stk x) tokenStack $ DL.zip [0..] ct
   let thisLen = (T.length hl)
   let remaining = T.drop thisLen cnt
   let nextOffset = hoffset + thisLen

   -- Process the new line in stream as well.
   case T.uncons remaining of
     Just ('\n', remaining') -> do
       let (_, newTokenStack') = pairWithTokens @a newTokenStack nextOffset "\n"
       pure $ Just (remaining', lnNo + 1, realoffset + (max 1 (DL.length ct)), nextOffset+1, newTokenStack')
     Just _  -> do
       pure $ Just (remaining, lnNo + 1, realoffset + (max 1 (DL.length ct)), nextOffset, newTokenStack)
     Nothing -> pure Nothing
   where

     linenumberWidth' = if showLineNos then epLinenumberWidth else 0

printOneSoftLine
 :: forall a m . (Highlightable a, WidgetC m)
 => EditorParams
 -> ScreenPos
 -> Maybe Location
 -> Maybe (Int, Int)
 -> Maybe Location
 -> Maybe Int
 -> Int
 -> Int
 -> Int
 -> Int -- The screen position y co-ordinate where the main, real line starts
 -> [a] -- The token stack at this point
 -> (Int, Text) -- The offset of this soft line, and the content
 -> m [a]  -- The token stack after printing this soft line
printOneSoftLine EditorParams {..} startPos debugLocation selection errorLocation mCursorLoc width height hoffset startLine tokenStack' (sfOffset, softLine) = do
  let startOffset = hoffset + (sfOffset * width)
  let realoffset' = startLine + sfOffset
  let (hlText, tokenStack'') = pairWithTokens @a tokenStack' startOffset softLine
  if (isPrintableArea realoffset' height)
      then do
        wSetCursor
          $ moveRight (linenumberWidth' + linenumberRightPad')
          $ moveDown realoffset' startPos
        hlText' <- case debugLocation of
          Just dLocation -> do
            pure $ (debugColor dLocation) <$> hlText
          Nothing -> pure ((\(a, b) -> (Plain a, b)) <$> hlText)
        hlText'' <- case selection of
          Just sLocation -> do
            pure $ snd $ DL.foldl' (selectionColor sLocation) (startOffset, []) hlText'
          Nothing -> pure hlText'
        hlText''' <- case errorLocation of
          Just dLocation -> do
            pure $ (errorColor dLocation) <$> hlText''
          Nothing -> pure hlText''
        hlText'''' <- case mCursorLoc of
          Just off -> do
            pure $ (markVirtualCursor startOffset off) <$> hlText'''
          Nothing -> pure hlText'''
        csPutText $ StyledText NoStyle ((highlight @a) <$> hlText'''')
      else
        pure ()
  pure tokenStack''
    where
      linenumberWidth = epLinenumberWidth
      linenumberRightPad = epLinenumberRightPad
      linenumberWidth' = if epLineNos then linenumberWidth else 0
      linenumberRightPad' = if epLineNos then linenumberRightPad else 0

      debugColor _ (src, Nothing) = (Plain src, Nothing)
      debugColor debugLoc (src, Just token) = let
         tokenLoc = getTokenLoc token
         in if tokenLoc == debugLoc then (StyledText TextUnderline [Plain src], Just token) else (Plain src, Just token)

      selectionColor :: (Int, Int) -> (Int, [(StyledText, Maybe a)]) -> (StyledText, Maybe a) -> (Int, [(StyledText, Maybe a)])
      selectionColor selectionLoc (startOffset, result) (src, a) =
        let
          newSrc = StyledText NoStyle
            (applyStyleToRange (\st -> StyledText (FgBg Black White) [st]) startOffset selectionLoc [src])
        in (startOffset + stTotalLength [src], result <> [(newSrc, a)])

      errorColor _ (src, Nothing) = (src, Nothing)
      errorColor errorLoc (src, Just token) = let
        tokenLoc = getTokenLoc token
       in if tokenLoc == errorLoc then (StyledText TextUnderline [src], Just token) else (src, Just token)

      markVirtualCursor :: Int -> Int -> (StyledText, Maybe a) -> (StyledText, Maybe a)
      markVirtualCursor startOffset cursorLoc (src, Nothing) =
        let
          newSrc = StyledText NoStyle
            (applyStyleToRange (\st -> StyledText (Bg Black) [st]) startOffset (cursorLoc, cursorLoc) [src])
        in (newSrc, Nothing)
      markVirtualCursor _ cursorLoc (src, Just token) =
        let
          newSrc = StyledText NoStyle (applyStyleToRange
            (\st -> StyledText (FgBg White Red) [st]) (lcOffset $ getTokenLoc token) (cursorLoc, cursorLoc) [src])
        in (newSrc, Just token)

isPrintableArea :: Int -> Int -> Bool
isPrintableArea y height = y >=0 && y < height

instance KeyInput EditorWidget where
  getCursorInfo ref = do
    ew <- readWRef ref
    let tp = getTextContentStart (ewDim ew) (ewParams ew)
    let (sp, cs) = ewCursorInfo ew
    pure $ Just (addSp (ewPos ew) (addSp tp (moveUp (ewScrollOffset ew) sp)), cs)
  handleInput ref ev = do
    modifyWRefM ref (updateOnInput ev)

instance Container EditorWidget Text where
  getContent ref = ewContent <$> readWRef ref
  setContent ref content = do
    modifyWRef ref (\w -> putCursor Nothing (min (ewCursor w) (T.length content - 1)) (w { ewContent = content }))

between :: Int -> (Int, Int) -> Bool
between a (b, c) = (b <= a) && (a <= c)

insertCharAt :: Char -> Int -> Text -> Text
insertCharAt c offset t = T.append (T.take offset t) (T.cons c (T.drop offset t))

replaceCharAt :: Char -> Int -> Text -> Text
replaceCharAt c offset t = T.append (T.take (max 0 (offset - 1)) t) (T.cons c (T.drop offset t))

removeCharAt :: Int -> Text -> Text
removeCharAt offset t = case T.drop offset t of
  "" -> t
  dropped -> T.append (T.take offset t) (T.tail dropped)

-- TODO: Move this logic to autocomplete handler
getAutoCompleteKey :: (HasLog m, MonadIO m) => Text -> Int -> m Text
getAutoCompleteKey cnt cursoroffset = do
  let contentTillCursor = T.take cursoroffset cnt
  case T.unsnoc contentTillCursor of
    Just (_, ' ') -> pure ""
    _             -> pure $ getLastWord "" contentTillCursor
  where
    getLastWord :: Text -> Text -> Text
    getLastWord r c = case T.unsnoc c of
      Nothing -> r
      Just (p, lc@((\ch -> T.cons ch "") -> lct)) ->
        if lct `T.isInfixOf` " \n(.,+-*/:{"
        then r else getLastWord (T.cons lc r) p

replaceLastWord :: (HasLog m, MonadIO m) => Text -> Int -> Text -> m (Text, Int)
replaceLastWord content cursor replacement = do
  lastword <- getAutoCompleteKey content cursor
  let
    lastWordLen = T.length lastword
    replacementLen = T.length replacement
  let newContent = T.concat [T.take (cursor - lastWordLen) content, replacement, T.drop cursor content]
  pure (newContent, (replacementLen - lastWordLen))

mkRange :: (Int, Int) -> (Int, Int)
mkRange (r1, r2)
  | (r2 > r1 && r2 > 0) = (r1, r2 - 1)
  | (r2 < r1 && r1 > 0) = (r2, r1 - 1)
  | otherwise = (r1, r2)

data CursorMovement
  = CVert CursorMovementVertical | CRIGHT Int | CLEFT | CHOME | CEND

data CursorMovementVertical
  = CUP | CDOWN

adjustScrollOffset :: WidgetC m => WRef EditorWidget -> m ()
adjustScrollOffset r =
  modifyWRef r (\ew -> putCursor Nothing 0 ew)

scrollToBottom :: WidgetC m => WRef EditorWidget -> m ()
scrollToBottom ewRef = do
  w <- readWRef ewRef
  let ch = (T.length $ ewContent w) - 1
  modifyWRef ewRef (\ew -> putCursor Nothing ch ew)

putCursor :: Maybe [Int] -> Int -> EditorWidget -> EditorWidget
putCursor mll nc ew = let
  lineLengths = fromMaybe (getLineLengths ew) mll
  (currentCursorSp, _) = ewCursorInfo ew
  in case offsetToScreenPos contentWidth lineLengths nc of
        Just (newsp, cl) -> let
          newEw = ew { ewCursorLine = cl, ewCursorInfo = (newsp, cStyle), ewCursor = nc }
          newScrollOffset =
            computeScrollOffset newEw newsp
          in newEw { ewScrollOffset = newScrollOffset }
        Nothing -> ew
  where
    (_, cStyle) = ewCursorInfo ew
    (_, contentWidth) = getTextPaddingAndSoftLineLength (ewDim ew) (ewParams ew)

getContetLines :: Text -> [Text]
getContetLines =  T.split (== '\n')

getLineLengths :: EditorWidget -> [Int]
getLineLengths ew =
  let
    contentLines = getContetLines (ewContent ew)
    -- Shoulnd't use T.lines here as behavior is different when the last char is a new line.
  in T.length <$> contentLines

moveCursor :: EditorWidget -> CursorMovement -> EditorWidget
moveCursor ew cm = case cm of
  CVert v -> moveCursorVertical ew v
  CRIGHT o -> newWidget o
  CLEFT -> newWidget (-1)
  CHOME -> let
    newLineOffset =  (sum (DL.take (ewCursorLine ew - 1) lineLengths)) + (ewCursorLine ew - 1)
    in newWidget (newLineOffset - currentCursor)
  CEND -> let
    newLineOffset = case T.findIndex (== '\n') (T.drop currentCursor content) of
      Just off -> off
      Nothing  -> T.length content - currentCursor
    in newWidget newLineOffset
  where
    newWidget off = let
      nc = min (T.length (ewContent ew)) (currentCursor + off)
      in putCursor (Just lineLengths) nc ew
    currentCursor = ewCursor ew
    lineLengths = getLineLengths ew
    content = ewContent ew

computeScrollOffset :: EditorWidget -> ScreenPos -> Int
computeScrollOffset ew newSp = let
  epBorderSize = if (epBorder $ ewParams ew) then 1 else 0
  contentHeight = (diH $ ewDim ew) - (2 * epBorderSize)
  cursorOverflow = (sY newSp - (ewScrollOffset ew)) - (contentHeight - 1)
  cursorUnderflow = (ewScrollOffset ew) - (sY newSp)
  in if cursorOverflow > 0
    then ewScrollOffset ew + cursorOverflow
    else if cursorUnderflow > 0
      then ewScrollOffset ew - cursorUnderflow
      else ewScrollOffset ew

moveCursorVertical :: EditorWidget -> CursorMovementVertical -> EditorWidget
moveCursorVertical ew cm =
    case screenPosToOffset lineLengths contentWidth newSp' of
      Just (newCursor, cursorLine, newSp) -> let
        newScrollOffset = computeScrollOffset ew newSp
        in ew { ewCursorLine = cursorLine, ewScrollOffset = newScrollOffset, ewCursorInfo = (newSp, cStyle), ewCursor = newCursor }
      Nothing -> ew

  where
    newSp' = case cm  of
      CUP   -> moveUp 1 currentSp
      CDOWN -> moveDown 1 currentSp
    (currentSp, cStyle) = ewCursorInfo ew
    lineLengths = T.length <$> contentLines
    contentLines = getContetLines $ ewContent ew
    (_, contentWidth) = getTextPaddingAndSoftLineLength (ewDim ew) (ewParams ew)

updateOnInput :: forall m. WidgetC m => KeyEvent -> EditorWidget -> m EditorWidget
updateOnInput ev ew = do
  if (ewReadOnly ew)
    then pure ew
    else do
      case ev of
        KeyCtrl _ sh _ ArrowUp -> simpleCursorMovement (CVert CUP) sh
        KeyCtrl _ sh _ ArrowDown -> simpleCursorMovement (CVert CDOWN) sh
        KeyCtrl _ sh _ End -> simpleCursorMovement CEND sh
        KeyCtrl _ sh _ Home -> simpleCursorMovement CHOME sh
        KeyCtrl _ sh _ ArrowRight -> simpleCursorMovement (CRIGHT 1) sh
        KeyCtrl _ sh _ ArrowLeft -> simpleCursorMovement CLEFT sh
        KeyCtrl _ _ _ Del  -> do
          let
            existing = ewContent ew
            cursor = ewCursor ew
          let newEw = ew { ewContent = removeCharAt cursor existing }
          checkShowAc newEw
          pure newEw
        KeyCtrl _ _ _ Esc  -> do
          hideAc ew
          pure ew
        KeyCtrl _ _ _ Backspace  -> if ewCursor ew > 0
          then
            let
              existing = ewContent ew
              cursor = ewCursor ew
            in do
              let newEw = moveCursor (ew { ewContent = removeCharAt (cursor - 1) existing }) CLEFT
              checkShowAc newEw
              pure newEw
          else pure ew
        KeyCtrl _ _ _ Return -> do
          isAutoCompleting ew ev >>= \case
            False -> updateOnInput (KeyChar False False False '\n') ew
            True -> do
              case ewAutocompleteWidget ew of
                Just (SomeWidgetRef ac) ->
                  withCapability (SelectableCap ac) $ do
                    selection <- getSelection ac
                    (newContent, cursorShift) <- replaceLastWord (ewContent ew) (ewCursor ew) selection
                    hideAc ew
                    pure $ moveCursor (ew { ewContent = newContent }) (CRIGHT cursorShift)
                Nothing -> pure ew
        KeyChar False False False (convertTab -> c)          -> case ewInsertMode ew of
          InsertMode -> do
            let newContent = insertCharAt c (ewCursor ew) (ewContent ew)
            let newEw = moveCursor (ew { ewContent = newContent}) (CRIGHT 1)
            checkShowAc newEw
            pure newEw
          ReplaceMode ->  pure ew -- disable replace mode now
        _                  -> pure ew
    where

      simpleCursorMovement
        :: CursorMovement
        -> Bool
        -> m EditorWidget
      simpleCursorMovement cm sh = do
        isAutoCompleting ew ev >>= \case
          True -> pure ew
          False -> do
            let newEw = moveCursor ew cm
            let newCursor = ewCursor newEw
            let newSelection = if sh
                  then
                    let
                      selectionStart = case ewSelection ew of
                        Just (SelectionInfo s _ _) -> s
                        Nothing -> ewCursor ew
                      (rs, re) = mkRange (selectionStart, newCursor)
                    in Just $ SelectionInfo selectionStart rs re
                  else Nothing
            pure $ newEw { ewSelection = newSelection }

      isAutoCompleting ew' key =
        case ewAutocompleteWidget ew' of
          Just (SomeWidgetRef ac) ->
            withCapability (DrawableCap ac) $ do
              getVisibility ac >>= \case
                True -> withCapability (KeyInputCap ac) $ do
                  handleInput ac key
                  pure True
                False -> pure False
          Nothing -> pure False
      hideAc ew' = do
        case ewAutocompleteWidget ew' of
          Just (SomeWidgetRef ac) ->
            withCapability (DrawableCap ac) $ do
              setVisibility ac False
          Nothing -> pure ()

      checkShowAc ew' = do
        case ewAutocompleteWidget ew' of
          Just (SomeWidgetRef ac) -> do
            key <- getAutoCompleteKey (ewContent ew') (ewCursor ew')
            withCapability (DrawableCap ac) $ do
              if T.null key
                then do
                    setVisibility ac False
                else do
                (ewAutocompleteSuggestions ew) key >>= \case
                  [] -> setVisibility ac False
                  [s] -> if (fst s) == key
                    then setVisibility ac False
                    else pass
                  suggestions@(_:_) -> withCapability (ContainerCap ac (Proxy @[(Text, Text)])) $ do
                    setContent ac (sortBy (\(a1, _) (a2, _) -> compare (T.length a1) (T.length a2)) suggestions)
                    setVisibility ac True
            pure ()
          Nothing -> pure ()

      convertTab '\t' = ' '
      convertTab c    = c

editor
  :: forall m. WidgetC m
  => (forall m1. MonadIO m1 => Text -> m1 [(Text, Text)])
  -> Maybe SomeTokenStream
  -> m (WRef EditorWidget)
editor mautocomplete mts =
  newWRef $ EditorWidget
    { ewContent = ""
    , ewDim = Dimensions 0 0
    , ewVisibility = True
    , ewPos = ScreenPos 0 0
    , ewCursor = 0
    , ewDebugLocation = Nothing
    , ewParseErrorLocation = Nothing
    , ewWordWrap = True
    , eweHasFocus = False
    , ewScrollOffset = 0
    , ewInsertMode = InsertMode
    , ewTokenStream = mts
    , ewAutocompleteWidget = Nothing
    , ewAutocompleteSuggestions = mautocomplete
    , ewReadOnly           = False
    , ewCursorInfo         = (ScreenPos 0 0, Bar)
    , ewSelection          = Nothing
    , ewShowVirtualCursor  = False
    , ewParams             = defaultEp
    , ewCursorLine         = 1
    }