From 46d9c6e4372cf8862a1f0f5ef8ae66c59dfada08 Mon Sep 17 00:00:00 2001
From: Armin Friedl <friedl.armin@gmail.com>
Date: Mon, 8 Aug 2016 23:47:14 +0200
Subject: [PATCH] tab works now

---
 hedit.cabal    |  3 ++-
 src/App/Gui.hs | 46 ++++++++++++++++++++++++++++------------------
 2 files changed, 30 insertions(+), 19 deletions(-)

diff --git a/hedit.cabal b/hedit.cabal
index faa3ade..6b9ab7d 100644
--- a/hedit.cabal
+++ b/hedit.cabal
@@ -66,7 +66,8 @@ executable hedit
                        microlens >=0.4 && <0.5, microlens-th >=0.4 && <0.5,
                        -- for Control.Monal.IO.Class
                        transformers >=0.5 && <0.6,
-                       directory
+                       directory,
+                       text-zipper
   
   -- Directories containing source files.
   hs-source-dirs:      src, src/App
diff --git a/src/App/Gui.hs b/src/App/Gui.hs
index 00a7f31..2acd981 100644
--- a/src/App/Gui.hs
+++ b/src/App/Gui.hs
@@ -20,6 +20,7 @@ import qualified Graphics.Vty           as Vty
 import           Data.Text              (pack, singleton, unpack)
 import           Data.Text.Markup       (Markup, fromText, markupSet, toText,
                                          (@@))
+import qualified Data.Text.Zipper       as TextZipper
 
 ---- Files ----
 import           System.Directory       (doesFileExist)
@@ -36,7 +37,7 @@ import           Data.Maybe
 import           Data.Monoid            (mempty, (<>))
 import           Data.String            (fromString)
 import           Data.Tuple
-import           Lens.Micro             ((^.))
+import           Lens.Micro             ((%~), (&), (^.))
 import           Lens.Micro.TH          (makeLenses)
 
 
@@ -82,30 +83,29 @@ drawContent = markup . (createMarkup []) . unlines
 -- add functions that return [(AttrName,Attr)] lists into foldl list
 -- for additional attributes
 getAttrMap :: AttrMap
-getAttrMap = foldl merge mainMap [Fontifier.fontMap]
+getAttrMap = foldl merge uiMap [Fontifier.fontMap]
   where merge map list = applyAttrMappings list map -- just reverses arguments of apply
-        mainMap = attrMap Vty.defAttr [
-           (attrName "blackOnWhite", Vty.white `on` Vty.brightMagenta),
-           (attrName "title", foldl Vty.withStyle (Vty.blue `on` Vty.brightYellow)
-                                                  [Vty.standout,Vty.bold,
-                                                   Vty.blink]),
-           (attrName "commands", Vty.white `on` Vty.magenta)
-          ]
+
+uiMap :: AttrMap
+uiMap = attrMap Vty.defAttr
+  [ (attrName "blackOnWhite", Vty.white `on` Vty.brightMagenta)
+  , (attrName "title"       , foldl Vty.withStyle (Vty.blue `on` Vty.brightYellow) [Vty.standout, Vty.bold])
+  , (attrName "commands"    , Vty.white `on` Vty.magenta)
+  ]
 
 drawUI :: HeditState -> [Widget Names]
-drawUI st = stackTopDown [titleBar, title, titleBar, commands] ++ [editWidget]
+drawUI st = vBox [titleBar, title, titleBar, commands] : [editWidget]
+  -- the where is a bit ugly, for an intuitive understanding just don't look at it
   where editWidget = padTop (Pad 5) $ EditWidget.renderEditor True (st^.hedit)
         hBorder = BorderWidgets.hBorder
-        commands = withAttr (attrName "commands") $ padLeft Max $ hBox [ str "^S"
-                                                                       , str "...Save"
+        commands = withAttr (attrName "commands") $ padLeft Max $ hBox [ str "^S...Save"
                                                                        , str "  │  "
-                                                                       , str "^C/Esc"
-                                                                       , str "...Quit "
+                                                                       , str "^C/Esc...Quit "
                                                                        ]
-        title = withAttr (attrName "title") $ CenterWidget.hCenter $
-                        str "HEDIT - The Not So Fancy Editor"
-        titleBar = withAttr (attrName "title") $ CenterWidget.hCenter $ str " "
-        stackTopDown widgets = [vBox widgets]  -- doesn't work with editor (at least i don't know how)
+        title = withAttr (attrName "title") $ CenterWidget.hCenter $ str "HEDIT - The Not So Fancy Editor"
+        titleBar = withAttr (attrName "title") $ CenterWidget.hCenter $ str " " -- creates an empty, colored bar
+                                                                                -- that spans the whole width
+                                                                                -- 1 line high
 
 appCursor :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names)
 appCursor st c = Just (head c)
@@ -114,6 +114,7 @@ appEvent :: HeditState -> Vty.Event -> EventM Names (Next HeditState)
 appEvent st ev
   | ev `elem` [esc, ctrl 'c']  = quit
   | ev == ctrl 's'             = save >> BrickMain.continue st
+  | ev == tab                  = insertFourSpaces >>= BrickMain.continue
   | otherwise                  = forwardToWidget >>= BrickMain.continue
   -- forget about the where, you can safely assume that what the
   -- names suggest is what is done
@@ -122,7 +123,16 @@ appEvent st ev
         save = liftIO (writeFile (st^.file) (unlines $ EditWidget.getEditContents $ st^.hedit))
         quit = halt st
         forwardToWidget = handleEventLensed st hedit EditWidget.handleEditorEvent ev
+        tab = Vty.EvKey (Vty.KChar '\t') []
+        insertFourSpaces = return $ insertString (replicate 4 ' ') st
 
+-- just don't ask what this does --- inserts a string, returns the state. end of story.
+insertString :: String -> HeditState -> HeditState
+insertString string st = st & hedit %~ insertString' string -- uses some fancy lense magic
+  where insertString' [] e = e
+        insertString' (a:aa) e = insertString' aa $ insertChar
+          -- inserts char a returns resulting editor
+          where insertChar = EditWidget.applyEdit (TextZipper.insertChar a) e
 
 drawHeditText :: [String] -> Widget n
 drawHeditText lines = makeWidget $ makeMarkup $ getFontification text