total conversion mod

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

editor.hs

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

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
+  

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

src/Main.hs

@@ -0,0 +1,8 @@
+module Main where
+
+import Gui (runEditor)
+import System.Environment (getArgs)
+
+main = do
+  args <- getArgs
+  runEditor $ head args