offset but somethings wrong

src/App/Fontifier.hs

@@ -68,13 +68,13 @@ fontMap = [ (attrName "assignment"   , fg Vty.blue)
           , (attrName "err_quotes"   , Vty.withStyle (fg Vty.red) Vty.underline) -- unbalanced quotes
           , (attrName "err_read"     , Vty.withStyle (fg Vty.yellow) Vty.underline) -- invalid read
           , (attrName "err_write"    , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid write
-          , (attrName "err_access"   , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid access (alternative if easier than invalid read/invalid write separated)
+          , (attrName "warn_access"  , Vty.withStyle (fg Vty.red) Vty.underline) -- invalid access (alternative if easier than invalid read/invalid write separated)
           ]
 
 fontify :: CheckString -> Fontifications
 fontify = concatApply [ assignments, strings
                       , returns, guards, comments
-                      , invalidAccess
+                      , warnAccess
                       , mismatchedBrackets
                       , mismatchedQuotes]
 
@@ -100,13 +100,13 @@ guards       = slicesToFT §: "guard"       §. matchGrpStripCmts 1  §~ "\\[([^
 
 mismatchedBrackets s = concatMap (mismatched §: "err_brackets" $ s) [('(',')'),('[',']'),('{','}')]
 
-invalidAccess      s =  let strip = prune $ (comments s) ++ (strings s) in -- removes strings and comments from fontification
+-- warnAccess      s =  let strip = prune $ (comments s) ++ (strings s) in -- removes strings and comments from fontification
-                        (slicesToFT §: "err_read"   $ strip $ invalidReads  s) ++
+--                        (slicesToFT §: "warn_read"   $ strip $ invalidReads  s) ++
-                        (slicesToFT §: "err_write"  $ strip $ invalidWrites s)
+--                        (slicesToFT §: "warn_write"  $ strip $ invalidWrites s)
 
 -- (alternative if easier than invalid read/invalid write separated)
--- invalidAccess    s =  let strip = prune $ (comments s) ++ (strings s) in
+warnAccess    s =  let strip = prune $ (comments s) ++ (strings s) in
---                       slicesToFT §: "err_access"   $ strip $ invAcc s
+                       slicesToFT §: "warn_access" $ strip $ invalidAccesses s
 
 {--- Utility Functions ---}
 
@@ -179,11 +179,15 @@ invalidReads s = [] -- do magic here
 --invalidWrites :: CheckString -> Slices
 invalidWrites s = [] -- do magic here
 
+-- facade to init invAcc
+invalidAccesses = invAcc [] "" 0
+
 -- (alternative if easier than invalid read/invalid write separated)
-invAcc :: [(String,Slice,Bool)] -> String -> CheckString -> Slices
+-- :: CurrentAssignments -> AccumulatorString -> GlobalIndex
-invAcc a _ ('{':t) = invAcc (enterBlock a) "" t
+invAcc :: [(String,Slice,Bool)] -> String -> Int -> CheckString -> Slices
-invAcc a accumStr ('}':t) = invAcc (leaveBlock a) "" t
+invAcc a accumStr i ('{':t) = invAcc (enterBlock a) "" (i+1+(length accumStr)) t
-invAcc a accumStr ('[':t) = invAcc a accumStr (drop g t)       -- TODO check reads in first part
+invAcc a accumStr i ('}':t) = invAcc (leaveBlock a) "" (i+1+(length accumStr)) t
+invAcc a accumStr i ('[':t) = invAcc a accumStr (i+1 + g+1) (drop g t)      -- TODO check reads in first part
   where g = fromJust (elemIndex ':' t)
 -- when reading an assignment :word: =
 -- put :word:, slice, false in the list
@@ -191,14 +195,19 @@ invAcc a accumStr ('[':t) = invAcc a accumStr (drop g t)       -- TODO check rea
 -- if it is found set its boolean value to true
 -- if it is not found add its slice to the result
 -- all variables with false at the end of a block are unused
-invAcc a accumStr (c:t) = let chkAccum = checkAccum 0 accumStr  -- we need to track the actual index position in the string
+invAcc a accumStr i (c:t) = let writeAcc = getWrite i accumStr
-                          in if isNothing chkAccum
+                            in if isNothing writeAcc
-                             then invAcc a (accumStr ++ [c]) t -- no assignment in accumStr
+                               then invAcc a (accumStr ++ [c]) i t -- no assignment in accumStr, don't advance offset
-                             else invAcc (a ++ [fromJust chkAccum]) "" t -- assignment in accumStr
+                               else invAcc (a ++ [fromJust writeAcc]) [c] (i+(length accumStr)) t -- assignment in accumStr, advance offset to end
-invAcc _ _ _ = []
+invAcc a _ _ _ = aToSlices a []
+  where aToSlices (a:as) slices = let a2 = (\(v,s,b) -> (s,b)) a
+                                  in if snd a2
+                                     then aToSlices as slices
+                                     else aToSlices as ((fst a2):slices)
+        aToSlices _ slices = slices
 
-checkAccum :: Int -> String -> Maybe (String, Slice, Bool)
+getWrite :: Int -> String -> Maybe (String, Slice, Bool)
-checkAccum offset accumStr = ((Tdfa.matchOnceText §~ "(\\**[[:word:]]+)[[:blank:]]*=") accumStr) >>= matchToA
+getWrite offset accumStr = ((Tdfa.matchOnceText §~ "(\\**[[:word:]]+)[[:blank:]]*=") accumStr) >>= matchToA
   where matchToA (before, match, after) =
           let m = match ! 1 -- extract the match group (0 = the whole match)
           in Just (fst m, (offset+(fst (snd m)), offset+(fst (snd m))+(snd (snd m))), False)
@@ -209,7 +218,7 @@ enterBlock = map (\(v,s,b) -> ('*':v,s,b))
 -- remove 1 * from each variable name
 -- if it cannot be removed, remove the variable
 leaveBlock :: [(String,Slice,Bool)] -> [(String,Slice,Bool)]
-leaveBlock _ = []
+leaveBlock a = a
 
 {- General Fontification Utilities -}