added directory dependency, merging of attribute maps, nicer ui

This commit is contained in:
Armin Friedl 2016-08-08 08:27:29 +02:00
parent a54d463cea
commit ee901c6cc0
3 changed files with 43 additions and 36 deletions

View file

@ -65,7 +65,8 @@ executable hedit
text >=1.1 && <1.2, text >=1.1 && <1.2,
microlens >=0.4 && <0.5, microlens-th >=0.4 && <0.5, microlens >=0.4 && <0.5, microlens-th >=0.4 && <0.5,
-- for Control.Monal.IO.Class -- for Control.Monal.IO.Class
transformers >=0.5 && <0.6 transformers >=0.5 && <0.6,
directory
-- Directories containing source files. -- Directories containing source files.
hs-source-dirs: src, src/App hs-source-dirs: src, src/App

View file

@ -5,7 +5,7 @@ module Fontifier (fontMap, fontify) where
{---- Imports ----} {---- Imports ----}
---- Brick, for markup specifications ---- ---- Brick, for markup specifications ----
import Brick.AttrMap (AttrMap, attrMap, attrName) import Brick.AttrMap (AttrName, attrName)
import Brick.Util (bg, fg) import Brick.Util (bg, fg)
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
@ -24,14 +24,12 @@ makeLenses ''Fontification
{---- Functions ----} {---- Functions ----}
fontMap :: AttrMap fontMap :: [(AttrName, Vty.Attr)]
fontMap = attrMap Vty.defAttr fontMap = [ (attrName "assignment" , fg Vty.blue)
[ , (attrName "return" , fg Vty.green)
(attrName "assignment" , fg Vty.blue), , (attrName "guard" , fg Vty.yellow)
(attrName "return" , fg Vty.green), , (attrName "err_braces" , fg Vty.red) -- unbalanced braces
(attrName "guard" , fg Vty.yellow), , (attrName "err_string" , fg Vty.red) -- unterminated strings
(attrName "err_braces" , fg Vty.red), -- unbalanced braces
(attrName "err_string" , fg Vty.red) -- unterminated strings
] ]
-- calls the fontification functions -- calls the fontification functions

View file

@ -1,4 +1,4 @@
{-# LANGUAGE TemplateHaskell #-} -- needed for lenses {-# LANGUAGE TemplateHaskell #-}
module Gui (runEditor) where module Gui (runEditor) where
@ -9,18 +9,20 @@ module Gui (runEditor) where
import Brick import Brick
import qualified Brick.Main as BrickMain import qualified Brick.Main as BrickMain
import Brick.Markup (markup) 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 import qualified Brick.Widgets.Edit as EditWidget
-- The underlying terminal package Brick is based upon -- The underlying terminal package Brick is based upon
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
---- Text ---- ---- Text ----
import Data.Text (unpack, pack, singleton) import Data.Text (pack, singleton, unpack)
import Data.Text.Markup (Markup, (@@), toText) import Data.Text.Markup (Markup, toText, (@@))
---- Files ---- ---- Files ----
import System.Directory (doesFileExist)
import System.IO (IOMode (..), hClose, hGetContents, import System.IO (IOMode (..), hClose, hGetContents,
openFile) openFile)
import System.Directory (doesFileExist)
---- Markup ---- ---- Markup ----
import qualified Fontifier as Fontifier import qualified Fontifier as Fontifier
@ -40,7 +42,7 @@ import Lens.Micro.TH (makeLenses)
-- Must be unique for every widget/viewport/cursor. -- Must be unique for every widget/viewport/cursor.
-- Add a new name with data Names = Hedit | NewName deriving(...) -- 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 data HeditState = HS { _hedit :: EditWidget.Editor Names
, _file :: FilePath , _file :: FilePath
} }
@ -52,23 +54,6 @@ makeLenses ''HeditState
runEditor :: FilePath -> IO () runEditor :: FilePath -> IO ()
runEditor f = do 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 exists <- doesFileExist f
content <- if exists then readFile f else return [] content <- if exists then readFile f else return []
st <- BrickMain.defaultMain theApp (initialState f content) st <- BrickMain.defaultMain theApp (initialState f content)
@ -80,7 +65,7 @@ theApp = App { appDraw = drawUI
, appChooseCursor = showFirstCursor , appChooseCursor = showFirstCursor
, appHandleEvent = appEvent , appHandleEvent = appEvent
, appStartEvent = return , appStartEvent = return
, appAttrMap = const $ Fontifier.fontMap , appAttrMap = const $ getAttrMap
, appLiftVtyEvent = id , appLiftVtyEvent = id
} }
@ -91,8 +76,31 @@ initialState f content = HS (EditWidget.editor Hedit drawContent Nothing content
drawContent :: [String] -> Widget n drawContent :: [String] -> Widget n
drawContent = markup . (createMarkup []) . unlines 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 :: 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 :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names)
appCursor st c = Just (head c) appCursor st c = Just (head c)
@ -101,7 +109,7 @@ appEvent :: HeditState -> Vty.Event -> EventM Names (Next HeditState)
appEvent st ev appEvent st ev
| ev `elem` [esc, ctrl 'c'] = quit | ev `elem` [esc, ctrl 'c'] = quit
| ev == ctrl 's' = save >> BrickMain.continue st | 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 -- forget about the where, you can safely assume that what the
-- names suggest is what is done -- names suggest is what is done
where ctrl key = Vty.EvKey (Vty.KChar key) [Vty.MCtrl] where ctrl key = Vty.EvKey (Vty.KChar key) [Vty.MCtrl]