From 76472ca35727055450ac15004e4f3aae6af12e25 Mon Sep 17 00:00:00 2001
From: Armin Friedl <friedl.armin@gmail.com>
Date: Mon, 15 Aug 2016 19:59:52 +0200
Subject: [PATCH] guards less strict, return fontifies until end, example2
 added

---
 Makefile                  |  5 ++++-
 test => examples/example1 |  1 -
 examples/example2         | 24 ++++++++++++++++++++++++
 hedit.cabal               |  3 ++-
 src/App/Fontifier.hs      | 22 ++++++++++++++++------
 5 files changed, 46 insertions(+), 9 deletions(-)
 rename test => examples/example1 (99%)
 create mode 100644 examples/example2

diff --git a/Makefile b/Makefile
index 66f318d..bffe3d4 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,10 @@ all:
 	cabal build
 
 test: all
-	dist/build/hedit/hedit test
+	dist/build/hedit/hedit examples/example1
+
+test2: all
+	dist/build/hedit/hedit examples/example2
 
 clean:
 	rm -fR dist/
diff --git a/test b/examples/example1
similarity index 99%
rename from test
rename to examples/example1
index e47a496..88cf956 100644
--- a/test
+++ b/examples/example1
@@ -1,4 +1,3 @@
-
 {    
     max = { % number a, number b, number c -> number or "error"
         [ c = "" : c = "0"; ] % by default use "0" if c not specified
diff --git a/examples/example2 b/examples/example2
new file mode 100644
index 0000000..8171948
--- /dev/null
+++ b/examples/example2
@@ -0,0 +1,24 @@
+{
+    error = "0";
+    fact = { % number num -> number; set error if something is wrong
+        continue = {} + ("test 1 -ge " + num).syscall;
+        [ continue = "0" :
+            [ {} + ("test 0 = " + num).syscall # "0" :
+            *error = "1";
+            ]
+            ^ "1";
+        ]
+        nextnum = { in = *num + "-1"; } + "bc -lq".iosyscall;
+        [ nextnum.result = "0" :
+            result = { in = { num = **nextnum.out; } + **fact + "*" + *nextnum.out; } + "bc -lq".iosyscall;
+            [ result.result = "0" :
+                ^ result.out;
+            ]
+        ]
+        *error = "2";
+        ^ "0";
+    }
+    value = { num = "5"; } + fact;
+    [ error = "0" : { in = "result: " + *value; } + "echo".iosyscall; ]
+    [ error # "0" : { in = "error #" + *error; } + "echo".iosyscall; ]
+}
diff --git a/hedit.cabal b/hedit.cabal
index a7c1f14..8282bf9 100644
--- a/hedit.cabal
+++ b/hedit.cabal
@@ -69,7 +69,8 @@ executable hedit
                        directory,
                        text-zipper,
                        array,
-                       regex-tdfa
+                       regex-tdfa,
+                       containers
   
   -- Directories containing source files.
   hs-source-dirs:      src, src/App
diff --git a/src/App/Fontifier.hs b/src/App/Fontifier.hs
index 3d773ed..822a213 100644
--- a/src/App/Fontifier.hs
+++ b/src/App/Fontifier.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell   #-}
+
 module Fontifier (fontMap, fontify, Fontification(..)) where
 
 {----  Imports  ----}
@@ -11,7 +13,9 @@ import qualified Text.Regex.TDFA as Tdfa
 ---- Various ----
 import           Data.Array
 import           Data.String
-import           Lens.Micro      ((^.), _1, _2)
+import           Lens.Micro      ((%~), (&), (.~), (^.))
+import           Lens.Micro.TH   (makeLenses)
+import qualified Data.Map as Map
 
 
 {---- Type Definitions ----}
@@ -28,6 +32,10 @@ type Slices          = [Slice]
 type MatchResult     = [Tdfa.MatchArray]
 type CheckString     = String
 type Regex           = Tdfa.Regex
+data BlockSlice      = BS Slice String
+data AccessSlice     = AS Slice String
+type BlockSlices     = [BlockSlice]
+type AccessSlices    = [AccessSlice]
 
 {---- Infix Operators ----}
 
@@ -61,11 +69,13 @@ fontMap = [ (attrName "assignment"   , fg Vty.blue)
           , (attrName "err_brackets" , bg Vty.red) -- unbalanced brackets
           , (attrName "err_quotes"   , Vty.withStyle (fg Vty.red) Vty.underline) -- unbalanced quotes
           , (attrName "err_unterm"   , Vty.withStyle (fg Vty.red) Vty.underline) -- missing ;
+          , (attrName "err_read"     , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid read
+          , (attrName "err_write"    , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid write
           ]
 
 fontify :: CheckString -> Fontifications
-fontify = concatApply [ assignments, returns
-                      , strings, guards, comments
+fontify = concatApply [ assignments, strings
+                      , returns, guards, comments
                       , mismatchedBrackets
                       , mismatchedQuotes]
 --                      , untermStrings
@@ -86,9 +96,9 @@ concatApply (f:fs) s = f s ++ concatApply fs s
 
 comments     = slicesToFT §: "comment"     §. matchAll             §~ "%.*"
 assignments  = slicesToFT §: "assignment"  §. matchGrpStripCmts 1  §~ "(\\**[[:word:]]+)[[:blank:]]*="
-returns      = slicesToFT §: "return"      §. matchStripCmts       §~ "[[:space:]]\\^"
+returns      = slicesToFT §: "return"      §. matchGrpStripCmts 1  §~ "([[:space:]]\\^.*);"
 strings      = slicesToFT §: "string"      §. matchStripCmts       §~ "\"[^%\"]*\""
-guards       = slicesToFT §: "guard"       §. matchGrpStripCmts 1  §~ "\\[(.+):.+\\]"
+guards       = slicesToFT §: "guard"       §. matchGrpStripCmts 1  §~ "\\[([^:]+):"
 
 {- Custom/Function-Based -}
 
@@ -156,7 +166,7 @@ mismatchedQuotes :: CheckString -> Fontifications
 mismatchedQuotes s = slicesToFT §: "err_quotes" $ firstChar untermed
   where matchedSlices = matchesToSlices $ (Tdfa.matchAll §~ "\"") s
         untermed = let commentsFts = comments s; stringsFts = strings s
-                   in negPrune (commentsFts++stringsFts) matchedSlices
+                   in negPrune (commentsFts++stringsFts) matchedSlices   
         negPrune _ [] = []
         negPrune checkFts (curSlice:slices)
           | not $ isFontified curSlice checkFts = curSlice: negPrune checkFts slices