UnicodeSyntax: search for -> in code

3 files changed, 74 insertions, 0 deletions

diff --git a/src/StylishHaskell/Stylish/UnicodeSyntax.hs b/src/StylishHaskell/Stylish/UnicodeSyntax.hs
new file mode 100644
index 0000000..3373a50
--- /dev/null
+++ b/src/StylishHaskell/Stylish/UnicodeSyntax.hs
@@ -0,0 +1,62 @@
+--------------------------------------------------------------------------------
+-- module StylishHaskell.Stylish.UnicodeSyntax where
+
+
+--------------------------------------------------------------------------------
+import qualified Language.Haskell.Exts.Annotated as H
+import System.Environment
+import Data.Maybe (maybeToList)
+import Data.List (isPrefixOf)
+
+
+--------------------------------------------------------------------------------
+import StylishHaskell.Stylish
+import StylishHaskell.Util
+import StylishHaskell.Parse
+
+
+--------------------------------------------------------------------------------
+types :: H.Module H.SrcSpanInfo -> Lines -> [(Int, Int)]
+types module' ls =
+    [ pos
+    | H.TyFun _ t1 t2 <- everything module'
+    , let start = H.srcSpanEnd $ H.srcInfoSpan $ H.ann t1
+    , let end   = H.srcSpanStart $ H.srcInfoSpan $ H.ann t2
+    , pos <- maybeToList $ between start end "->" ls
+    ]
+
+
+--------------------------------------------------------------------------------
+-- | Search for a needle in a haystack of lines. Only part the inside (startRow,
+-- startCol), (endRow, endCol) is searched. The return value is the position of
+-- the needle.
+between :: (Int, Int) -> (Int, Int) -> String -> Lines -> Maybe (Int, Int)
+between (startRow, startCol) (endRow, endCol) needle =
+    search (startRow, startCol) .
+    withLast (take endCol) .
+    withHead (drop $ startCol - 1) .
+    take (endRow - startRow + 1) .
+    drop (startRow - 1)
+  where
+    withHead _ []       = []
+    withHead f (x : xs) = (f x) : xs
+
+    withLast f [x]      = [f x]
+    withLast f (x : xs) = x : withLast f xs
+    withLast _ []       = []
+
+    search _      []            = Nothing
+    search (r, _) ([] : xs)     = search (r + 1, 1) xs
+    search (r, c) (x : xs)
+        | needle `isPrefixOf` x = Just (r, c)
+        | otherwise             = search (r, c + 1) (tail x : xs)
+
+
+--------------------------------------------------------------------------------
+main :: IO ()
+main = do
+    (filePath : _) <- getArgs
+    contents       <- readFile filePath
+    case parseModule (Just filePath) contents of
+        Left err           -> error err
+        Right (module', _) -> print $ types module' (lines contents)
diff --git a/src/StylishHaskell/Util.hs b/src/StylishHaskell/Util.hs
index 436abc3..2a78f56 100644
--- a/src/StylishHaskell/Util.hs
+++ b/src/StylishHaskell/Util.hs
@@ -2,10 +2,15 @@
 module StylishHaskell.Util
     ( nameToString
     , padRight
+    , everything
     ) where
 
 
 --------------------------------------------------------------------------------
+import           Data.Data                       (Data)
+import qualified Data.Generics                   as G
+import           Data.Maybe                      (maybeToList)
+import           Data.Typeable                   (cast)
 import qualified Language.Haskell.Exts.Annotated as H
 
 
@@ -19,3 +24,8 @@ nameToString (H.Symbol _ str) = str
 --------------------------------------------------------------------------------
 padRight :: Int -> String -> String
 padRight len str = str ++ replicate (len - length str) ' '
+
+
+--------------------------------------------------------------------------------
+everything :: (Data a, Data b) => a -> [b]
+everything = G.everything (++) (maybeToList . cast)
diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal
index e0b47ac..0136031 100644
--- a/stylish-haskell.cabal
+++ b/stylish-haskell.cabal
@@ -45,6 +45,7 @@ Executable stylish-haskell
     directory        >= 1.1  && < 1.2,
     filepath         >= 1.1  && < 1.4,
     haskell-src-exts >= 1.13 && < 1.14,
+    syb              >= 0.3  && < 0.4,
     yaml             >= 0.7  && < 0.8
 
 Test-suite stylish-haskell-tests
@@ -72,6 +73,7 @@ Test-suite stylish-haskell-tests
     directory        >= 1.1  && < 1.2,
     filepath         >= 1.1  && < 1.4,
     haskell-src-exts >= 1.13 && < 1.14,
+    syb              >= 0.3  && < 0.4,
     yaml             >= 0.7  && < 0.8
 
 Source-repository head