diff --git a/src/App/Fontifier.hs b/src/App/Fontifier.hs index 66c240f..733d57e 100644 --- a/src/App/Fontifier.hs +++ b/src/App/Fontifier.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} -- needed for lenses - -module Fontifier (fontMap, fontify) where +module Fontifier (fontMap, fontify, Fontification(..)) where {---- Imports ----} @@ -10,17 +8,14 @@ import Brick.Util (bg, fg) import qualified Graphics.Vty as Vty ---- Various ---- -import Lens.Micro -import Lens.Micro.TH (makeLenses) {---- Type Definitions ----} -- defines an attribute for a text slice -data Fontification = FT { _ftStart :: Integer -- start index in string - , _ftEnd :: Integer -- end index in string - , _ftAttr :: String -- attribute name - } -makeLenses ''Fontification +data Fontification = FT { ftStart :: Int -- start index in string + , ftEnd :: Int -- end index in string + , ftAttr :: AttrName -- attribute name + } deriving (Show) {---- Functions ----} @@ -28,6 +23,7 @@ fontMap :: [(AttrName, Vty.Attr)] fontMap = [ (attrName "assignment" , fg Vty.blue) , (attrName "return" , fg Vty.green) , (attrName "guard" , fg Vty.yellow) + , (attrName "comment" , fg Vty.green) , (attrName "err_braces" , fg Vty.red) -- unbalanced braces , (attrName "err_string" , fg Vty.red) -- unterminated strings ] @@ -35,4 +31,13 @@ fontMap = [ (attrName "assignment" , fg Vty.blue) -- calls the fontification functions -- and returns a list of attributes for text slices fontify :: String -> [Fontification] -fontify s = [] +fontify s = testFontify s 0 + + +-- fontifies every occurence of a as error +testFontify :: String -> Int -> [Fontification] +testFontify [] _ = [] +testFontify (s:ss) c = if s == 'a' + then (FT c (c+1) (attrName "err_string")): testFontify ss (c+1) + else testFontify ss (c+1) + diff --git a/src/App/Gui.hs b/src/App/Gui.hs index 3634de3..00a7f31 100644 --- a/src/App/Gui.hs +++ b/src/App/Gui.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} -module Gui (runEditor) where +module Gui (runEditor, fontifyToMarkup) where {---- Imports ----} @@ -17,7 +18,8 @@ import qualified Graphics.Vty as Vty ---- Text ---- import Data.Text (pack, singleton, unpack) -import Data.Text.Markup (Markup, toText, (@@)) +import Data.Text.Markup (Markup, fromText, markupSet, toText, + (@@)) ---- Files ---- import System.Directory (doesFileExist) @@ -25,13 +27,14 @@ import System.IO (IOMode (..), hClose, hGetContents, openFile) ---- Markup ---- -import qualified Fontifier as Fontifier +import Fontifier ---- Various ---- import Control.Monad.IO.Class (liftIO) import Data.List import Data.Maybe import Data.Monoid (mempty, (<>)) +import Data.String (fromString) import Data.Tuple import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) @@ -70,36 +73,38 @@ theApp = App { appDraw = drawUI } initialState :: FilePath -> String -> HeditState -initialState f content = HS (EditWidget.editor Hedit drawContent Nothing content) +initialState f content = HS (EditWidget.editor Hedit drawHeditText Nothing content) (f) drawContent :: [String] -> Widget n drawContent = markup . (createMarkup []) . unlines --- add functions that return [(AttrName,Attr)] lists +-- add functions that return [(AttrName,Attr)] lists into foldl list -- for additional attributes getAttrMap :: AttrMap getAttrMap = foldl merge mainMap [Fontifier.fontMap] where merge map list = applyAttrMappings list map -- just reverses arguments of apply mainMap = attrMap Vty.defAttr [ - (attrName "blackOnWhite", Vty.brightBlack `on` Vty.brightWhite), + (attrName "blackOnWhite", Vty.white `on` Vty.brightMagenta), (attrName "title", foldl Vty.withStyle (Vty.blue `on` Vty.brightYellow) [Vty.standout,Vty.bold, - Vty.blink]) + Vty.blink]), + (attrName "commands", Vty.white `on` Vty.magenta) ] drawUI :: HeditState -> [Widget Names] -drawUI st = stackTopDown [title, hBorder, commands, hBorder] ++ [editWidget] - where editWidget = padTop (Pad 4) $ EditWidget.renderEditor True (st^.hedit) +drawUI st = stackTopDown [titleBar, title, titleBar, commands] ++ [editWidget] + where editWidget = padTop (Pad 5) $ EditWidget.renderEditor True (st^.hedit) hBorder = BorderWidgets.hBorder - commands = hBox [str "Commands: " - , withAttr (attrName "blackOnWhite") $ str "^S" - , str "...Save " - , withAttr (attrName "blackOnWhite") $ str "^C/Esc" - , str "...Quit" - ] + commands = withAttr (attrName "commands") $ padLeft Max $ hBox [ str "^S" + , str "...Save" + , str " │ " + , str "^C/Esc" + , str "...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) appCursor :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names) @@ -119,8 +124,27 @@ appEvent st ev forwardToWidget = handleEventLensed st hedit EditWidget.handleEditorEvent ev +drawHeditText :: [String] -> Widget n +drawHeditText lines = makeWidget $ makeMarkup $ getFontification text + where makeWidget = markup -- just a synonym for Brick.Markup.markup + text = unlinesWA lines -- make a single text junk from splitted lines + getFontification = Fontifier.fontify -- just a synonym + makeMarkup = fontifyToMarkup text -- curried fontifyToMarkup; needs an additional fontification list only +fontifyToMarkup :: String -> [Fontification] -> Markup AttrName +fontifyToMarkup text fontification = fontifyToMarkup' baseMarkup fontification + -- fromText marks the given text with the default markup + -- fromString creates a Data.Text from a String (works because of OverloadedStrings extension) + where baseMarkup = (fromText $ fromString text) +-- Workhorse of fontifyToMarkup +-- merges all the fontification information into the given Markup and +-- returns the merged markup +fontifyToMarkup' :: Markup AttrName -> [Fontification] -> Markup AttrName +fontifyToMarkup' markup [] = markup +fontifyToMarkup' markup (f:ff) = fontifyToMarkup' (markupSet slice attribute markup) ff + where slice = ((ftStart f),(ftEnd f)-(ftStart f)) -- slice = (startIndex, length) + attribute = ftAttr f