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,
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

View file

@ -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,14 +24,12 @@ 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

View file

@ -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]