added directory dependency, merging of attribute maps, nicer ui
This commit is contained in:
Armin Friedl
parent
a54d463cea
commit
ee901c6cc0
3 changed files with 43 additions and 36 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
Loading…
Reference in a new issue