diff --git a/hedit.cabal b/hedit.cabal index 642505c..faa3ade 100644 --- a/hedit.cabal +++ b/hedit.cabal @@ -65,7 +65,8 @@ executable hedit text >=1.1 && <1.2, microlens >=0.4 && <0.5, microlens-th >=0.4 && <0.5, -- for Control.Monal.IO.Class - transformers >=0.5 && <0.6 + transformers >=0.5 && <0.6, + directory -- Directories containing source files. hs-source-dirs: src, src/App diff --git a/src/App/Fontifier.hs b/src/App/Fontifier.hs index aa64563..66c240f 100644 --- a/src/App/Fontifier.hs +++ b/src/App/Fontifier.hs @@ -5,7 +5,7 @@ module Fontifier (fontMap, fontify) where {---- Imports ----} ---- Brick, for markup specifications ---- -import Brick.AttrMap (AttrMap, attrMap, attrName) +import Brick.AttrMap (AttrName, attrName) import Brick.Util (bg, fg) import qualified Graphics.Vty as Vty @@ -24,15 +24,13 @@ makeLenses ''Fontification {---- Functions ----} -fontMap :: AttrMap -fontMap = attrMap Vty.defAttr - [ - (attrName "assignment" , fg Vty.blue), - (attrName "return" , fg Vty.green), - (attrName "guard" , fg Vty.yellow), - (attrName "err_braces" , fg Vty.red), -- unbalanced braces - (attrName "err_string" , fg Vty.red) -- unterminated strings - ] +fontMap :: [(AttrName, Vty.Attr)] +fontMap = [ (attrName "assignment" , fg Vty.blue) + , (attrName "return" , fg Vty.green) + , (attrName "guard" , fg Vty.yellow) + , (attrName "err_braces" , fg Vty.red) -- unbalanced braces + , (attrName "err_string" , fg Vty.red) -- unterminated strings + ] -- calls the fontification functions -- and returns a list of attributes for text slices diff --git a/src/App/Gui.hs b/src/App/Gui.hs index 4039fba..3634de3 100644 --- a/src/App/Gui.hs +++ b/src/App/Gui.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} -- needed for lenses +{-# LANGUAGE TemplateHaskell #-} module Gui (runEditor) where @@ -9,18 +9,20 @@ module Gui (runEditor) where import Brick import qualified Brick.Main as BrickMain import Brick.Markup (markup) +import qualified Brick.Widgets.Border as BorderWidgets +import qualified Brick.Widgets.Center as CenterWidget import qualified Brick.Widgets.Edit as EditWidget -- The underlying terminal package Brick is based upon import qualified Graphics.Vty as Vty ---- Text ---- -import Data.Text (unpack, pack, singleton) -import Data.Text.Markup (Markup, (@@), toText) +import Data.Text (pack, singleton, unpack) +import Data.Text.Markup (Markup, toText, (@@)) ---- Files ---- +import System.Directory (doesFileExist) import System.IO (IOMode (..), hClose, hGetContents, openFile) -import System.Directory (doesFileExist) ---- Markup ---- import qualified Fontifier as Fontifier @@ -40,7 +42,7 @@ import Lens.Micro.TH (makeLenses) -- Must be unique for every widget/viewport/cursor. -- Add a new name with data Names = Hedit | NewName deriving(...) -data Names = Hedit deriving (Ord, Show, Eq) +data Names = Hedit | HeditView deriving (Ord, Show, Eq) data HeditState = HS { _hedit :: EditWidget.Editor Names , _file :: FilePath } @@ -52,23 +54,6 @@ makeLenses ''HeditState runEditor :: FilePath -> IO () runEditor f = do --- gave me: *** Exception: Gui.hs: hGetContents: illegal operation (delayed read on closed handle) --- handle <- openFile f ReadWriteMode -- creates file if it does not exist --- content <- hGetContents handle - {- - reads the content before closing the handle (non-lazy) - this is the version with the fewest "dependecies" - other options: - - ByteString.hGetContents: strict, fast - -> ByteString.Lazy for lazy, fast - - Text.IO.hGetContents: strict, needs 2x file size while reading in - -> filesize == 2xRAM = bad - - Pass the handler around instead of filename, close at exit - -> works with all above options (incl. the lazy variants, i think) - -> locks the file MultiReader/SingleWriter for free (i think) - -} --- content `seq` hClose handle - exists <- doesFileExist f content <- if exists then readFile f else return [] st <- BrickMain.defaultMain theApp (initialState f content) @@ -80,7 +65,7 @@ theApp = App { appDraw = drawUI , appChooseCursor = showFirstCursor , appHandleEvent = appEvent , appStartEvent = return - , appAttrMap = const $ Fontifier.fontMap + , appAttrMap = const $ getAttrMap , appLiftVtyEvent = id } @@ -91,8 +76,31 @@ initialState f content = HS (EditWidget.editor Hedit drawContent Nothing content drawContent :: [String] -> Widget n drawContent = markup . (createMarkup []) . unlines +-- add functions that return [(AttrName,Attr)] lists +-- 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 "title", foldl Vty.withStyle (Vty.blue `on` Vty.brightYellow) + [Vty.standout,Vty.bold, + Vty.blink]) + ] + drawUI :: HeditState -> [Widget Names] -drawUI st = [EditWidget.renderEditor True (st^.hedit)] +drawUI st = stackTopDown [title, hBorder, commands, hBorder] ++ [editWidget] + where editWidget = padTop (Pad 4) $ 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" + ] + title = withAttr (attrName "title") $ CenterWidget.hCenter $ + str "HEDIT - The Not So Fancy Editor" + stackTopDown widgets = [vBox widgets] -- doesn't work with editor (at least i don't know how) appCursor :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names) appCursor st c = Just (head c) @@ -101,7 +109,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 - | otherwise = BrickMain.continue =<< forwardToWidget + | otherwise = forwardToWidget >>= BrickMain.continue -- forget about the where, you can safely assume that what the -- names suggest is what is done where ctrl key = Vty.EvKey (Vty.KChar key) [Vty.MCtrl]