added directory dependency, merging of attribute maps, nicer ui
This commit is contained in:
parent
a54d463cea
commit
ee901c6cc0
3 changed files with 43 additions and 36 deletions
|
@ -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
|
||||||
|
|
|
@ -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,15 +24,13 @@ 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
|
||||||
-- and returns a list of attributes for text slices
|
-- and returns a list of attributes for text slices
|
||||||
|
|
|
@ -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]
|
||||||
|
|
Loading…
Reference in a new issue