From c0ef142c4117be26e8220a0a80127ecfc3066fb3 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 17 Apr 2016 00:24:59 +0200
Subject: [PATCH] Check in hsimport.hs and create hacking subdir

---
 HACKING.md => hacking/HACKING.md |  0
 hacking/hsimport.hs              | 59 ++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+)
 rename HACKING.md => hacking/HACKING.md (100%)
 create mode 100644 hacking/hsimport.hs

diff --git a/HACKING.md b/hacking/HACKING.md
similarity index 100%
rename from HACKING.md
rename to hacking/HACKING.md
diff --git a/hacking/hsimport.hs b/hacking/hsimport.hs
new file mode 100644
index 0000000..4f15c54
--- /dev/null
+++ b/hacking/hsimport.hs
@@ -0,0 +1,59 @@
+import Data.List
+import qualified Language.Haskell.Exts as HS
+import HsImport
+
+main :: IO ()
+main = hsimport $ defaultConfig { prettyPrint = prettyPrint
+                                , findImportPos = findImportPos }
+   where
+      -- This is a bogus implementation of prettyPrint, because it doesn't
+      -- handle the qualified import case nor does it considers any explicitely
+      -- imported or hidden symbols.
+      prettyPrint :: HS.ImportDecl -> String
+      prettyPrint (HS.ImportDecl sloc modname qual _ _ mpkg mas mspec) =
+        "import " ++ (ifStr qual "qualified") ++
+        (maybe "" (\pkg -> " \"" ++ pkg ++ "\" ") mpkg)  ++
+        getMN modname ++ (maybe "" (\name -> " as " ++ getMN name) $ mas) ++
+        specprint mspec
+
+      specprint :: Maybe (Bool, [HS.ImportSpec]) -> String
+      specprint Nothing = ""
+      specprint (Just (False, xs))
+        = "\n  (\n" ++ printImportSpecs xs ++ "\n  )"
+      specprint (Just (True, xs))
+        = "\n  hiding (\n" ++ printImportSpecs xs ++ "\n  )"
+
+      printImportSpecs :: [HS.ImportSpec] -> String
+      printImportSpecs ins
+          = let (x:xs) = sort ins
+            in  "    " ++ printSpec x ++ "\n" ++ go xs
+        where
+          go []       = ""
+          go [x']     = "  , " ++ printSpec x'
+          go (x':xs') = "  , " ++ printSpec x' ++ "\n" ++ go xs'
+          printSpec :: HS.ImportSpec -> String
+          printSpec = HS.prettyPrint
+    
+
+      -- This findImportPos implementation will always add the new import
+      -- declaration at the end of the current ones. The data type ImportPos
+      -- has the two constructors After and Before.
+      findImportPos :: HS.ImportDecl -> [HS.ImportDecl] -> Maybe ImportPos
+      findImportPos _         []             = Nothing
+      findImportPos newImport currentImports = Just findPos
+        where
+          lastPos = After . last $ currentImports
+          findPos = let xs = takeWhile (\x -> (getMN $ HS.importModule x)
+                                              <
+                                              (getMN $ HS.importModule newImport)
+                                       )
+                             . sort
+                             $ currentImports
+                    in if null xs then lastPos else After . last $ xs
+
+      ifStr :: Bool -> String -> String
+      ifStr True str = str
+      ifStr False _  = ""
+
+      getMN :: HS.ModuleName -> String
+      getMN (HS.ModuleName name) = name