diff --git a/README.txt b/README.txt new file mode 100644 index 0000000..e69de29 diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/editor.hs b/editor.hs deleted file mode 100644 index 6d78150..0000000 --- a/editor.hs +++ /dev/null @@ -1,90 +0,0 @@ -import Brick -import Brick.Markup -import Data.Maybe -import Data.Monoid -import Data.List -import Data.Tuple -import Data.Default -import Data.Text (pack, singleton, unpack) -import Data.Text.Markup -import Control.Monad -import Control.Monad.IO.Class -import Control.Concurrent -import Control.DeepSeq -import System.Environment -import qualified Brick.Widgets.Edit as E -import qualified Graphics.Vty as V - -import Control.Exception.Base -import Debug.Trace - -data Name = Text deriving (Ord, Show, Eq) -type St = E.Editor Name - -brackets = [('(',')'),('[',']'),('{','}')] - -initialState :: String -> St -initialState = E.editor Text drawContent Nothing - -drawContent :: [String] -> Widget n -drawContent = markup . (createMarkup []) . unlinesWA - --- workaround because empty lines don't work with Markup -unlinesWA :: [String] -> String -unlinesWA [] = "" -unlinesWA (l:ls) = l ++ (" \n" ++ unlinesWA ls) - -createMarkup :: String -> String -> Markup V.Attr -createMarkup _ [] = mempty -createMarkup p s@('"':ss) = case i of - Just n -> (pack (take (2+n) s) @@ fg V.blue) <> (createMarkup (reverse (take (2+n) s) ++ s) (drop (1+n) ss)) - Nothing -> pack s @@ fg V.red - where i = elemIndex '"' ss -createMarkup p (c:ss) - | isJust ob && mismatched (fromJust ob) ss 1 - || isJust cb && mismatched (swap $ fromJust cb) p 1 = (singleton c @@ bg V.red) <> r - | otherwise = (singleton c @@ fg V.white) <> r - where ob = find ((== c).fst) brackets - cb = find ((== c).snd) brackets - r = createMarkup (c:p) ss - -mismatched :: (Char, Char) -> String -> Int -> Bool -mismatched _ _ 0 = False -mismatched _ [] _ = True -mismatched b@(ob, cb) (c:cs) d - | c == ob = mismatched b cs $ d+1 - | c == cb = mismatched b cs $ d-1 - | otherwise = mismatched b cs d - -drawUI :: St -> [Widget Name] -drawUI st = [E.renderEditor True st] - -appCursor :: St -> [CursorLocation Name] -> Maybe (CursorLocation Name) -appCursor st c = Just (head c) - -appEvent :: String -> St -> V.Event -> EventM Name (Next St) -appEvent s st ev = - case ev of - V.EvKey V.KEsc [] -> halt st - V.EvKey (V.KChar 'c') [V.MCtrl] -> halt st - V.EvKey (V.KChar 's') [V.MCtrl] -> liftIO (writeFile s (unlines $ E.getEditContents $ st)) >> continue st - _ -> continue =<< E.handleEditorEvent ev st - -theApp :: String -> App St V.Event Name -theApp s = - App { appDraw = drawUI - , appChooseCursor = showFirstCursor - , appHandleEvent = appEvent s - , appStartEvent = return - , appAttrMap = const (attrMap V.defAttr [ ]) - , appLiftVtyEvent = id - } - -main = do - f <- do - a <- getArgs - return $ head a - c <- readFile f - st <- defaultMain (theApp f) (initialState c) - void $ return st --- putStrLn $ unlines $ E.getEditContents $ st diff --git a/hedit.cabal b/hedit.cabal new file mode 100644 index 0000000..64b6031 --- /dev/null +++ b/hedit.cabal @@ -0,0 +1,82 @@ +-- Initial hedit.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: hedit + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Editor for the property list programming language + +-- A longer description of the package. +-- description: + +-- URL for the project homepage or repository. +homepage: hedit.notld + +-- The license under which the package is released. +-- license: + +-- The file containing the license text. +-- license-file: LICENSE + +-- The package author(s). +author: prosa + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: prosa@hedit.notld + +-- A copyright notice. +-- copyright: + +category: Text + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +-- extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +executable hedit + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- only extensions that are used by every module + -- else use {-# LANGUAGE ... #-} pragma in file + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <4.8, + text, + brick, vty, + microlens, microlens-th, + -- for Control.Monal.IO.Class + transformers + + -- Directories containing source files. + hs-source-dirs: src, src/App + + -- Base language which the package is written in. + default-language: Haskell2010 + + -- GHC Options use other-extensions if possible + ghc-options: -O3 + -- concurrency support + -rtsopts -with-rtsopts=-N -threaded + \ No newline at end of file diff --git a/src/App/Gui.hs b/src/App/Gui.hs new file mode 100644 index 0000000..689258b --- /dev/null +++ b/src/App/Gui.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE TemplateHaskell #-} -- needed for makeLenses + +module Gui (runEditor) where + + +{---- Imports ----} + +---- Brick ---- +import Brick +import Brick.Markup (markup) +import qualified Brick.Main as BrickMain +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 (pack, singleton) +import Data.Text.Markup (Markup, (@@)) + +---- Various ---- +import Lens.Micro ((^.)) +import Lens.Micro.TH (makeLenses) +import Control.Monad.IO.Class (liftIO) +import Data.Monoid (mempty, (<>)) +import Data.Maybe +import Data.List +import Data.Tuple + + + +{---- Type Definitions ----} + +-- 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 HeditState = HS { _hedit :: EditWidget.Editor Names + , _file :: FilePath + } +makeLenses ''HeditState + + + + +{---- Functions ----} + +runEditor :: FilePath -> IO () +runEditor f = do + content <- readFile f + _ <- BrickMain.defaultMain theApp (initialState f content) + return () + +theApp :: App HeditState Vty.Event Names +theApp = App { appDraw = drawUI + , appChooseCursor = showFirstCursor + , appHandleEvent = appEvent + , appStartEvent = return + , appAttrMap = const (attrMap Vty.defAttr [ ]) + , appLiftVtyEvent = id + } + +initialState :: FilePath -> String -> HeditState +initialState f content = HS (EditWidget.editor Hedit drawContent Nothing content) + (f) + +drawContent :: [String] -> Widget n +drawContent = markup . (createMarkup []) . unlinesWA + +drawUI :: HeditState -> [Widget Names] +drawUI st = [EditWidget.renderEditor True (st^.hedit)] + +appCursor :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names) +appCursor st c = Just (head c) + +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 + -- 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] + esc = Vty.EvKey Vty.KEsc [] + save = liftIO (writeFile (st^.file) (unlines $ EditWidget.getEditContents $ st^.hedit)) + quit = halt st + forwardToWidget = handleEventLensed st hedit EditWidget.handleEditorEvent ev + + + + + + + +-- TODO Refactor parts into SyntaxChecker.hs somehow + +brackets :: [(Char,Char)] +brackets = [('(',')'),('[',']'),('{','}')] + +-- workaround because empty lines don't work with Markup +unlinesWA :: [String] -> String +unlinesWA [] = "" +unlinesWA (l:ls) = l ++ (" \n" ++ unlinesWA ls) + +mismatched :: (Char, Char) -> String -> Int -> Bool +mismatched _ _ 0 = False +mismatched _ [] _ = True +mismatched b@(ob, cb) (c:cs) d + | c == ob = mismatched b cs $ d+1 + | c == cb = mismatched b cs $ d-1 + | otherwise = mismatched b cs d + +createMarkup :: String -> String -> Markup Vty.Attr +createMarkup _ [] = mempty +createMarkup p s@('"':ss) = case i of + Just n -> (pack (take (2+n) s) @@ fg Vty.blue) <> (createMarkup (reverse (take (2+n) s) ++ s) (drop (1+n) ss)) + Nothing -> pack s @@ fg Vty.red + where i = elemIndex '"' ss +createMarkup p (c:ss) + | isJust ob && mismatched (fromJust ob) ss 1 + || isJust cb && mismatched (swap $ fromJust cb) p 1 = (singleton c @@ bg Vty.red) <> r + | otherwise = (singleton c @@ fg Vty.white) <> r + where ob = find ((== c).fst) brackets + cb = find ((== c).snd) brackets + r = createMarkup (c:p) ss diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..8cf1768 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Gui (runEditor) +import System.Environment (getArgs) + +main = do + args <- getArgs + runEditor $ head args