From 1efa712dc57a3335f56eb0bd353f0f2ba7085645 Mon Sep 17 00:00:00 2001
From: Vincent Hanquez <vincent@snarc.org>
Date: Fri, 3 Apr 2015 08:19:48 +0100
Subject: [PATCH] add QA "script". for now doesn't do anything except listing
 extensions

---
 .gitignore |  3 ++-
 QA.hs      | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 58 insertions(+), 1 deletion(-)
 create mode 100644 QA.hs

diff --git a/.gitignore b/.gitignore
index 12bab5f..829e1f2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,6 +3,7 @@
 *.tix
 *.mix
 gen/Gen
-gen/Crypto
+gen/Crypto/*
 dist
+QA
 *.sublime-workspace
diff --git a/QA.hs b/QA.hs
new file mode 100644
index 0000000..0b48251
--- /dev/null
+++ b/QA.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+
+import Language.Haskell.Exts
+import Data.List
+import System.Directory
+import System.FilePath
+import System.Posix.Files
+import Control.Monad
+import Control.Applicative ((<$>))
+import Control.Exception
+
+
+main = do
+    modules <- findAllModules
+    mapM_ qa modules
+  where qa file = do
+            putStrLn ("==== " ++ file)
+            content <- readFile file
+            let mexts = readExtensions content
+            case mexts of
+                Nothing        -> printError "[ERR] failed to parsed extension"
+                Just (_, exts) -> putStrLn ("extensions : " ++ (intercalate ", " $ map show exts))
+        printError = putStrLn
+
+findAllModules :: IO [FilePath]
+findAllModules = dirTraverse "Crypto" fileCallback dirCallback []
+  where
+        fileCallback a m = return (if isSuffixOf ".hs" m then (m:a) else a)
+        dirCallback a d
+            | isSuffixOf "/.git" d = return (False, a)
+            | otherwise            = return (True, a)
+
+-- | Traverse directories and files starting from the @rootDir
+dirTraverse :: FilePath
+            -> (a -> FilePath -> IO a)
+            -> (a -> FilePath -> IO (Bool, a))
+            -> a
+            -> IO a
+dirTraverse rootDir fFile fDir a = loop a rootDir
+  where loop a dir = do
+            content <- try $ getDir dir
+            case content of
+                Left (exn :: SomeException) -> return a
+                Right l  -> foldM (processEnt dir) a l
+        processEnt dir a ent = do
+            let fp = dir </> ent
+            stat <- getSymbolicLinkStatus fp
+            case (isDirectory stat, isRegularFile stat) of
+                (True,_)     -> do (process,a') <- fDir a fp
+                                   if process
+                                      then loop a' fp
+                                      else return a'
+                (False,True)  -> fFile a fp
+                (False,False) -> return a
+        getDir dir = filter (not . flip elem [".",".."]) <$> getDirectoryContents dir