packages feed

haskell-tools-refactor 0.4.1.0 → 0.4.1.1

raw patch · 319 files changed

+3896/−10 lines, 319 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Language.Haskell.Tools.Refactor.Session: loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc ([a], [String])
+ Language.Haskell.Tools.Refactor.Session: loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc (Either String ([a], [String]))

Files

Language/Haskell/Tools/Refactor/Session.hs view
@@ -14,6 +14,8 @@ import Debug.Trace
 
 import GHC
+import Outputable
+import ErrUtils
 import GhcMonad as GHC
 import HscTypes as GHC
 import Digraph as GHC
@@ -42,7 +44,7 @@   initSession = RefactorSessionState []
 
 
-loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc ([a], [String])
+loadPackagesFrom :: IsRefactSessionState st => (ModSummary -> IO a) -> [FilePath] -> StateT st Ghc (Either String ([a], [String]))
 loadPackagesFrom report packages = 
   do modColls <- liftIO $ getAllModules packages
      modify $ refSessMCs .- (++ modColls)
@@ -51,13 +53,14 @@      let (ignored, modNames) = extractDuplicates $ map (^. sfkModuleName) $ concat $ map Map.keys $ modColls ^? traversal & mcModules
          alreadyExistingMods = concatMap (map (^. sfkModuleName) . Map.keys . (^. mcModules)) (allModColls List.\\ modColls)
      lift $ mapM addTarget $ map (\mod -> (Target (TargetModule (GHC.mkModuleName mod)) True Nothing)) modNames
-     withAlteredDynFlags (return . enableAllPackages allModColls) $ do
-       modsForColls <- lift $ depanal [] True
-       let modsToParse = flattenSCCs $ topSortModuleGraph False modsForColls Nothing
-           actuallyCompiled = filter (not . (`elem` alreadyExistingMods) . modSumName) modsToParse
-       checkEvaluatedMods report modsToParse
-       mods <- mapM (loadModule report) actuallyCompiled
-       return (mods, ignored)
+     handleSourceError (return . Left . concat . List.intersperse "\n\n" . map showSDocUnsafe . pprErrMsgBagWithLoc . srcErrorMessages) $
+       withAlteredDynFlags (return . enableAllPackages allModColls) $ do
+         modsForColls <- lift $ depanal [] True
+         let modsToParse = flattenSCCs $ topSortModuleGraph False modsForColls Nothing
+             actuallyCompiled = filter (not . (`elem` alreadyExistingMods) . modSumName) modsToParse
+         checkEvaluatedMods report modsToParse
+         mods <- mapM (loadModule report) actuallyCompiled
+         return $ Right (mods, ignored)
 
   where extractDuplicates :: Eq a => [a] -> ([a],[a])
         extractDuplicates (a:rest)
+ examples/CppHs/Language/Preprocessor/Cpphs.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.Preprocessor.Cpphs
+-- Copyright   :  2000-2006 Malcolm Wallace
+-- Licence     :  LGPL
+--
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+--
+-- Include the interface that is exported
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs
+  ( runCpphs, runCpphsPass1, runCpphsPass2, runCpphsReturningSymTab
+  , cppIfdef, tokenise, WordStyle(..)
+  , macroPass, macroPassReturningSymTab
+  , CpphsOptions(..), BoolOptions(..)
+  , parseOptions, defaultCpphsOptions, defaultBoolOptions
+  , module Language.Preprocessor.Cpphs.Position
+  ) where
+
+import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef)
+import Language.Preprocessor.Cpphs.MacroPass(macroPass
+                                            ,macroPassReturningSymTab)
+import Language.Preprocessor.Cpphs.RunCpphs(runCpphs
+                                           ,runCpphsPass1
+                                           ,runCpphsPass2
+                                           ,runCpphsReturningSymTab)
+import Language.Preprocessor.Cpphs.Options
+       (CpphsOptions(..), BoolOptions(..), parseOptions
+       ,defaultCpphsOptions,defaultBoolOptions)
+import Language.Preprocessor.Cpphs.Position
+import Language.Preprocessor.Cpphs.Tokenise
+ examples/CppHs/Language/Preprocessor/Cpphs/CppIfdef.hs view
@@ -0,0 +1,416 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  CppIfdef
+-- Copyright   :  1999-2004 Malcolm Wallace
+-- Licence     :  LGPL
+-- 
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+
+-- Perform a cpp.first-pass, gathering \#define's and evaluating \#ifdef's.
+-- and \#include's.
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs.CppIfdef
+  ( cppIfdef    -- :: FilePath -> [(String,String)] -> [String] -> Options
+                --      -> String -> IO [(Posn,String)]
+  ) where
+
+
+import Text.Parse
+import Language.Preprocessor.Cpphs.SymTab
+import Language.Preprocessor.Cpphs.Position  (Posn,newfile,newline,newlines
+                                             ,cppline,cpp2hask,newpos)
+import Language.Preprocessor.Cpphs.ReadFirst (readFirst)
+import Language.Preprocessor.Cpphs.Tokenise  (linesCpp,reslash)
+import Language.Preprocessor.Cpphs.Options   (BoolOptions(..))
+import Language.Preprocessor.Cpphs.HashDefine(HashDefine(..),parseHashDefine
+                                             ,expandMacro)
+import Language.Preprocessor.Cpphs.MacroPass (preDefine,defineMacro)
+import Data.Char        (isDigit,isSpace,isAlphaNum)
+import Data.List        (intercalate,isPrefixOf)
+import Numeric          (readHex,readOct,readDec)
+import System.IO.Unsafe (unsafeInterleaveIO)
+import System.IO        (hPutStrLn,stderr)
+import Control.Monad    (when)
+
+-- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's,
+--   whilst taking account of \#define's and \#undef's as we encounter them.
+cppIfdef :: FilePath            -- ^ File for error reports
+        -> [(String,String)]    -- ^ Pre-defined symbols and their values
+        -> [String]             -- ^ Search path for \#includes
+        -> BoolOptions          -- ^ Options controlling output style
+        -> String               -- ^ The input file content
+        -> IO [(Posn,String)]   -- ^ The file after processing (in lines)
+cppIfdef fp syms search options =
+    cpp posn defs search options (Keep []) . initial . linesCpp
+  where
+    posn = newfile fp
+    defs = preDefine options syms
+    initial = if literate options then id else (cppline posn:)
+-- Previous versions had a very simple symbol table  mapping strings
+-- to strings.  Now the #ifdef pass uses a more elaborate table, in
+-- particular to deal with parameterised macros in conditionals.
+
+
+-- | Internal state for whether lines are being kept or dropped.
+--   In @Drop n b ps@, @n@ is the depth of nesting, @b@ is whether
+--   we have already succeeded in keeping some lines in a chain of
+--   @elif@'s, and @ps@ is the stack of positions of open @#if@ contexts,
+--   used for error messages in case EOF is reached too soon.
+data KeepState = Keep [Posn] | Drop Int Bool [Posn]
+
+-- | Return just the list of lines that the real cpp would decide to keep.
+cpp :: Posn -> SymTab HashDefine -> [String] -> BoolOptions -> KeepState
+       -> [String] -> IO [(Posn,String)]
+
+cpp _ _ _ _ (Keep ps) [] | not (null ps) = do
+    hPutStrLn stderr $ "Unmatched #if: positions of open context are:\n"++
+                       unlines (map show ps)
+    return []
+cpp _ _ _ _ _ [] = return []
+
+cpp p syms path options (Keep ps) (l@('#':x):xs) =
+    let ws = words x
+        cmd = if null ws then "" else head ws
+        line = tail ws
+        sym  = head (tail ws)
+        rest = tail (tail ws)
+        def = defineMacro options (sym++" "++ maybe "1" id (un rest))
+        un v = if null v then Nothing else Just (unwords v)
+        keepIf b = if b then Keep (p:ps) else Drop 1 False (p:ps)
+        skipn syms' retain ud xs' =
+            let n = 1 + length (filter (=='\n') l) in
+            (if macros options && retain then emitOne  (p,reslash l)
+                                         else emitMany (replicate n (p,""))) $
+            cpp (newlines n p) syms' path options ud xs'
+    in case cmd of
+        "define" -> skipn (insertST def syms) True (Keep ps) xs
+        "undef"  -> skipn (deleteST sym syms) True (Keep ps) xs
+        "ifndef" -> skipn syms False (keepIf (not (definedST sym syms))) xs
+        "ifdef"  -> skipn syms False (keepIf      (definedST sym syms)) xs
+        "if"     -> do b <- gatherDefined p syms (unwords line)
+                       skipn syms False (keepIf b) xs
+        "else"   -> skipn syms False (Drop 1 False ps) xs
+        "elif"   -> skipn syms False (Drop 1 True ps) xs
+        "endif"  | null ps ->
+                    do hPutStrLn stderr $ "Unmatched #endif at "++show p
+                       return []
+        "endif"  -> skipn syms False (Keep (tail ps)) xs
+        "pragma" -> skipn syms True  (Keep ps) xs
+        ('!':_)  -> skipn syms False (Keep ps) xs       -- \#!runhs scripts
+        "include"-> do (inc,content) <- readFirst (file syms (unwords line))
+                                                  p path
+                                                  (warnings options)
+                       cpp p syms path options (Keep ps)
+                             (("#line 1 "++show inc): linesCpp content
+                                                    ++ cppline (newline p): xs)
+        "warning"-> if warnings options then
+                      do hPutStrLn stderr (l++"\nin "++show p)
+                         skipn syms False (Keep ps) xs
+                    else skipn syms False (Keep ps) xs
+        "error"  -> error (l++"\nin "++show p)
+        "line"   | all isDigit sym
+                 -> (if locations options && hashline options then emitOne (p,l)
+                     else if locations options then emitOne (p,cpp2hask l)
+                     else id) $
+                    cpp (newpos (read sym) (un rest) p)
+                        syms path options (Keep ps) xs
+        n | all isDigit n && not (null n)
+                 -> (if locations options && hashline options then emitOne (p,l)
+                     else if locations options then emitOne (p,cpp2hask l)
+                     else id) $
+                    cpp (newpos (read n) (un (tail ws)) p)
+                        syms path options (Keep ps) xs
+          | otherwise
+                 -> do when (warnings options) $
+                           hPutStrLn stderr ("Warning: unknown directive #"++n
+                                             ++"\nin "++show p)
+                       emitOne (p,l) $
+                               cpp (newline p) syms path options (Keep ps) xs
+
+cpp p syms path options (Drop n b ps) (('#':x):xs) =
+    let ws = words x
+        cmd = if null ws then "" else head ws
+        delse    | n==1 && b = Drop 1 b ps
+                 | n==1      = Keep ps
+                 | otherwise = Drop n b ps
+        dend     | n==1      = Keep (tail ps)
+                 | otherwise = Drop (n-1) b (tail ps)
+        delif v  | n==1 && not b && v
+                             = Keep ps
+                 | otherwise = Drop n b ps
+        skipn ud xs' =
+                 let n' = 1 + length (filter (=='\n') x) in
+                 emitMany (replicate n' (p,"")) $
+                    cpp (newlines n' p) syms path options ud xs'
+    in
+    if      cmd == "ifndef" ||
+            cmd == "if"     ||
+            cmd == "ifdef" then    skipn (Drop (n+1) b (p:ps)) xs
+    else if cmd == "elif"  then do v <- gatherDefined p syms (unwords (tail ws))
+                                   skipn (delif v) xs
+    else if cmd == "else"  then    skipn  delse xs
+    else if cmd == "endif" then
+            if null ps then do hPutStrLn stderr $ "Unmatched #endif at "++show p
+                               return []
+                       else skipn  dend  xs
+    else skipn (Drop n b ps) xs
+        -- define, undef, include, error, warning, pragma, line
+
+cpp p syms path options (Keep ps) (x:xs) =
+    let p' = newline p in seq p' $
+    emitOne (p,x)  $  cpp p' syms path options (Keep ps) xs
+cpp p syms path options d@(Drop _ _ _) (_:xs) =
+    let p' = newline p in seq p' $
+    emitOne (p,"") $  cpp p' syms path options d xs
+
+
+-- | Auxiliary IO functions
+emitOne  ::  a  -> IO [a] -> IO [a]
+emitMany :: [a] -> IO [a] -> IO [a]
+emitOne  x  io = do ys <- unsafeInterleaveIO io
+                    return (x:ys)
+emitMany xs io = do ys <- unsafeInterleaveIO io
+                    return (xs++ys)
+
+
+----
+gatherDefined :: Posn -> SymTab HashDefine -> String -> IO Bool
+gatherDefined p st inp =
+  case runParser (preExpand st) inp of
+    (Left msg, _) -> error ("Cannot expand #if directive in file "++show p
+                           ++":\n    "++msg)
+    (Right s, xs) -> do
+--      hPutStrLn stderr $ "Expanded #if at "++show p++" is:\n  "++s
+        when (any (not . isSpace) xs) $
+             hPutStrLn stderr ("Warning: trailing characters after #if"
+                              ++" macro expansion in file "++show p++": "++xs)
+
+        case runParser parseBoolExp s of
+          (Left msg, _) -> error ("Cannot parse #if directive in file "++show p
+                                 ++":\n    "++msg)
+          (Right b, xs) -> do when (any (not . isSpace) xs && notComment xs) $
+                                   hPutStrLn stderr
+                                     ("Warning: trailing characters after #if"
+                                      ++" directive in file "++show p++": "++xs)
+                              return b
+
+notComment = not . ("//"`isPrefixOf`) . dropWhile isSpace
+
+
+-- | The preprocessor must expand all macros (recursively) before evaluating
+--   the conditional.
+preExpand :: SymTab HashDefine -> TextParser String
+preExpand st =
+  do  eof
+      return ""
+  <|>
+  do  a <- many1 (satisfy notIdent)
+      commit $ pure (a++) `apply` preExpand st
+  <|>
+  do  b <- expandSymOrCall st
+      commit $ pure (b++) `apply` preExpand st
+
+-- | Expansion of symbols.
+expandSymOrCall :: SymTab HashDefine -> TextParser String
+expandSymOrCall st =
+  do sym <- parseSym
+     if sym=="defined" then do arg <- skip parseSym; convert sym [arg]
+                            <|>
+                            do arg <- skip $ parenthesis (do x <- skip parseSym;
+                                                             skip (return x))
+                               convert sym [arg]
+                            <|> convert sym []
+      else
+      ( do  args <- parenthesis (commit $ fragment `sepBy` skip (isWord ","))
+            args' <- flip mapM args $ \arg->
+                         case runParser (preExpand st) arg of
+                             (Left msg, _) -> fail msg
+                             (Right s, _)  -> return s
+            convert sym args'
+        <|> convert sym []
+      )
+  where
+    fragment = many1 (satisfy (`notElem`",)"))
+    convert "defined" [arg] =
+      case lookupST arg st of
+        Nothing | all isDigit arg    -> return arg 
+        Nothing                      -> return "0"
+        Just (a@AntiDefined{})       -> return "0"
+        Just (a@SymbolReplacement{}) -> return "1"
+        Just (a@MacroExpansion{})    -> return "1"
+    convert sym args =
+      case lookupST sym st of
+        Nothing  -> if null args then return sym
+                    else return "0"
+                 -- else fail (disp sym args++" is not a defined macro")
+        Just (a@SymbolReplacement{}) -> do reparse (replacement a)
+                                           return ""
+        Just (a@MacroExpansion{})    -> do reparse (expandMacro a args False)
+                                           return ""
+        Just (a@AntiDefined{})       ->
+                    if null args then return sym
+                    else return "0"
+                 -- else fail (disp sym args++" explicitly undefined with -U")
+    disp sym args = let len = length args
+                        chars = map (:[]) ['a'..'z']
+                    in sym ++ if null args then ""
+                              else "("++intercalate "," (take len chars)++")"
+
+parseBoolExp :: TextParser Bool
+parseBoolExp =
+  do  a <- parseExp1
+      bs <- many (do skip (isWord "||")
+                     commit $ skip parseBoolExp)
+      return $ foldr (||) a bs
+
+parseExp1 :: TextParser Bool
+parseExp1 =
+  do  a <- parseExp0
+      bs <- many (do skip (isWord "&&")
+                     commit $ skip parseExp1)
+      return $ foldr (&&) a bs
+
+parseExp0 :: TextParser Bool
+parseExp0 =
+  do  skip (isWord "!")
+      a <- commit $ parseExp0
+      return (not a)
+  <|>
+  do  val1 <- parseArithExp1
+      op   <- parseCmpOp
+      val2 <- parseArithExp1
+      return (val1 `op` val2)
+  <|>
+  do  sym <- parseArithExp1
+      case sym of
+        0 -> return False
+        _ -> return True
+  <|>
+  do  parenthesis (commit parseBoolExp)
+
+parseArithExp1 :: TextParser Integer
+parseArithExp1 =
+  do  val1 <- parseArithExp0
+      ( do op   <- parseArithOp1
+           val2 <- parseArithExp1
+           return (val1 `op` val2)
+        <|> return val1 )
+  <|>
+  do  parenthesis parseArithExp1
+
+parseArithExp0 :: TextParser Integer
+parseArithExp0 =
+  do  val1 <- parseNumber
+      ( do op   <- parseArithOp0
+           val2 <- parseArithExp0
+           return (val1 `op` val2)
+        <|> return val1 )
+  <|>
+  do  parenthesis parseArithExp0
+
+parseNumber :: TextParser Integer
+parseNumber = fmap safeRead $ skip parseSym
+  where
+    safeRead s =
+      case s of
+        '0':'x':s' -> number readHex s'
+        '0':'o':s' -> number readOct s'
+        _          -> number readDec s
+    number rd s =
+      case rd s of
+        []        -> 0 :: Integer
+        ((n,_):_) -> n :: Integer
+
+parseCmpOp :: TextParser (Integer -> Integer -> Bool)
+parseCmpOp =
+  do  skip (isWord ">=")
+      return (>=)
+  <|>
+  do  skip (isWord ">")
+      return (>)
+  <|>
+  do  skip (isWord "<=")
+      return (<=)
+  <|>
+  do  skip (isWord "<")
+      return (<)
+  <|>
+  do  skip (isWord "==")
+      return (==)
+  <|>
+  do  skip (isWord "!=")
+      return (/=)
+
+parseArithOp1 :: TextParser (Integer -> Integer -> Integer)
+parseArithOp1 =
+  do  skip (isWord "+")
+      return (+)
+  <|>
+  do  skip (isWord "-")
+      return (-)
+
+parseArithOp0 :: TextParser (Integer -> Integer -> Integer)
+parseArithOp0 =
+  do  skip (isWord "*")
+      return (*)
+  <|>
+  do  skip (isWord "/")
+      return (div)
+  <|>
+  do  skip (isWord "%")
+      return (rem)
+
+-- | Return the expansion of the symbol (if there is one).
+parseSymOrCall :: SymTab HashDefine -> TextParser String
+parseSymOrCall st =
+  do  sym <- skip parseSym
+      args <- parenthesis (commit $ parseSymOrCall st `sepBy` skip (isWord ","))
+      return $ convert sym args
+  <|>
+  do  sym <- skip parseSym
+      return $ convert sym []
+  where
+    convert sym args =
+      case lookupST sym st of
+        Nothing  -> sym
+        Just (a@SymbolReplacement{}) -> recursivelyExpand st (replacement a)
+        Just (a@MacroExpansion{})    -> recursivelyExpand st (expandMacro a args False)
+        Just (a@AntiDefined{})       -> name a
+
+recursivelyExpand :: SymTab HashDefine -> String -> String
+recursivelyExpand st inp =
+  case runParser (parseSymOrCall st) inp of
+    (Left msg, _) -> inp
+    (Right s,  _) -> s
+
+parseSym :: TextParser String
+parseSym = many1 (satisfy (\c-> isAlphaNum c || c`elem`"'`_"))
+           `onFail`
+           do xs <- allAsString
+              fail $ "Expected an identifier, got \""++xs++"\""
+
+notIdent :: Char -> Bool
+notIdent c = not (isAlphaNum c || c`elem`"'`_")
+
+skip :: TextParser a -> TextParser a
+skip p = many (satisfy isSpace) >> p
+
+-- | The standard "parens" parser does not work for us here.  Define our own.
+parenthesis :: TextParser a -> TextParser a
+parenthesis p = do isWord "("
+                   x <- p
+                   isWord ")"
+                   return x
+
+-- | Determine filename in \#include
+file :: SymTab HashDefine -> String -> String
+file st name =
+    case name of
+      ('"':ns) -> init ns
+      ('<':ns) -> init ns
+      _ -> let ex = recursivelyExpand st name in
+           if ex == name then name else file st ex
+
+ examples/CppHs/Language/Preprocessor/Cpphs/HashDefine.hs view
@@ -0,0 +1,129 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  HashDefine
+-- Copyright   :  2004 Malcolm Wallace
+-- Licence     :  LGPL
+--
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+--
+-- What structures are declared in a \#define.
+-----------------------------------------------------------------------------
+ 
+module Language.Preprocessor.Cpphs.HashDefine
+  ( HashDefine(..)
+  , ArgOrText(..)
+  , expandMacro
+  , parseHashDefine
+  , simplifyHashDefines
+  ) where
+
+import Data.Char (isSpace)
+import Data.List (intercalate)
+
+data HashDefine
+        = LineDrop
+                { name :: String }
+        | Pragma
+                { name :: String }
+        | AntiDefined
+                { name          :: String
+                , linebreaks    :: Int
+                }
+        | SymbolReplacement
+                { name          :: String
+                , replacement   :: String
+                , linebreaks    :: Int
+                }
+        | MacroExpansion
+                { name          :: String
+                , arguments     :: [String]
+                , expansion     :: [(ArgOrText,String)]
+                , linebreaks    :: Int
+                }
+    deriving (Eq,Show)
+
+-- | 'smart' constructor to avoid warnings from ghc (undefined fields)
+symbolReplacement :: HashDefine
+symbolReplacement =
+    SymbolReplacement
+         { name=undefined, replacement=undefined, linebreaks=undefined }
+
+-- | Macro expansion text is divided into sections, each of which is classified
+--   as one of three kinds: a formal argument (Arg), plain text (Text),
+--   or a stringised formal argument (Str).
+data ArgOrText = Arg | Text | Str deriving (Eq,Show)
+
+-- | Expand an instance of a macro.
+--   Precondition: got a match on the macro name.
+expandMacro :: HashDefine -> [String] -> Bool -> String
+expandMacro macro parameters layout =
+    let env = zip (arguments macro) parameters
+        replace (Arg,s)  = maybe ("")      id (lookup s env)
+        replace (Str,s)  = maybe (str "") str (lookup s env)
+        replace (Text,s) = if layout then s else filter (/='\n') s
+        str s = '"':s++"\""
+        checkArity | length (arguments macro) == 1 && length parameters <= 1
+                   || length (arguments macro) == length parameters = id
+                   | otherwise = error ("macro "++name macro++" expected "++
+                                        show (length (arguments macro))++
+                                        " arguments, but was given "++
+                                        show (length parameters))
+    in
+    checkArity $ concatMap replace (expansion macro)
+
+-- | Parse a \#define, or \#undef, ignoring other \# directives
+parseHashDefine :: Bool -> [String] -> Maybe HashDefine
+parseHashDefine ansi def = (command . skip) def
+  where
+    skip xss@(x:xs) | all isSpace x = skip xs
+                    | otherwise     = xss
+    skip    []      = []
+    command ("line":xs)   = Just (LineDrop ("#line"++concat xs))
+    command ("pragma":xs) = Just (Pragma ("#pragma"++concat xs))
+    command ("define":xs) = Just (((define . skip) xs) { linebreaks=count def })
+    command ("undef":xs)  = Just (((undef  . skip) xs))
+    command _             = Nothing
+    undef  (sym:_)   = AntiDefined { name=sym, linebreaks=0 }
+    define (sym:xs)  = case {-skip-} xs of
+                           ("(":ys) -> (macroHead sym [] . skip) ys
+                           ys   -> symbolReplacement
+                                     { name=sym
+                                     , replacement = concatMap snd
+                                             (classifyRhs [] (chop (skip ys))) }
+    macroHead sym args (",":xs) = (macroHead sym args . skip) xs
+    macroHead sym args (")":xs) = MacroExpansion
+                                    { name =sym , arguments = reverse args
+                                    , expansion = classifyRhs args (skip xs)
+                                    , linebreaks = undefined }
+    macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs
+    macroHead sym args []       = error ("incomplete macro definition:\n"
+                                        ++"  #define "++sym++"("
+                                        ++intercalate "," args)
+    classifyRhs args ("#":x:xs)
+                          | ansi &&
+                            x `elem` args    = (Str,x): classifyRhs args xs
+    classifyRhs args ("##":xs)
+                          | ansi             = classifyRhs args xs
+    classifyRhs args (s:"##":s':xs)
+                          | ansi && all isSpace s && all isSpace s'
+                                             = classifyRhs args xs
+    classifyRhs args (word:xs)
+                          | word `elem` args = (Arg,word): classifyRhs args xs
+                          | otherwise        = (Text,word): classifyRhs args xs
+    classifyRhs _    []                      = []
+    count = length . filter (=='\n') . concat
+    chop  = reverse . dropWhile (all isSpace) . reverse
+
+-- | Pretty-print hash defines to a simpler format, as key-value pairs.
+simplifyHashDefines :: [HashDefine] -> [(String,String)]
+simplifyHashDefines = concatMap simp
+  where
+    simp hd@LineDrop{}    = []
+    simp hd@Pragma{}      = []
+    simp hd@AntiDefined{} = []
+    simp hd@SymbolReplacement{} = [(name hd, replacement hd)]
+    simp hd@MacroExpansion{}    = [(name hd++"("++intercalate "," (arguments hd)
+                                           ++")"
+                                   ,concatMap snd (expansion hd))]
+ examples/CppHs/Language/Preprocessor/Cpphs/MacroPass.hs view
@@ -0,0 +1,184 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  MacroPass
+-- Copyright   :  2004 Malcolm Wallace
+-- Licence     :  LGPL
+--
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+--
+-- Perform a cpp.second-pass, accumulating \#define's and \#undef's,
+-- whilst doing symbol replacement and macro expansion.
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs.MacroPass
+  ( macroPass
+  , preDefine
+  , defineMacro
+  , macroPassReturningSymTab
+  ) where
+
+import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro
+                                              , simplifyHashDefines)
+import Language.Preprocessor.Cpphs.Tokenise   (tokenise, WordStyle(..)
+                                              , parseMacroCall)
+import Language.Preprocessor.Cpphs.SymTab     (SymTab, lookupST, insertST
+                                              , emptyST, flattenST)
+import Language.Preprocessor.Cpphs.Position   (Posn, newfile, filename, lineno)
+import Language.Preprocessor.Cpphs.Options    (BoolOptions(..))
+import System.IO.Unsafe (unsafeInterleaveIO)
+import Control.Monad    ((=<<))
+import System.Time       (getClockTime, toCalendarTime, formatCalendarTime)
+import System.Locale     (defaultTimeLocale)
+
+noPos :: Posn
+noPos = newfile "preDefined"
+
+-- | Walk through the document, replacing calls of macros with the expanded RHS.
+macroPass :: [(String,String)]  -- ^ Pre-defined symbols and their values
+          -> BoolOptions        -- ^ Options that alter processing style
+          -> [(Posn,String)]    -- ^ The input file content
+          -> IO String          -- ^ The file after processing
+macroPass syms options =
+    fmap (safetail              -- to remove extra "\n" inserted below
+         . concat
+         . onlyRights)
+    . macroProcess (pragma options) (layout options) (lang options)
+                   (preDefine options syms)
+    . tokenise (stripEol options) (stripC89 options)
+               (ansi options) (lang options)
+    . ((noPos,""):)     -- ensure recognition of "\n#" at start of file
+  where
+    safetail [] = []
+    safetail (_:xs) = xs
+
+-- | auxiliary
+onlyRights :: [Either a b] -> [b]
+onlyRights = concatMap (\x->case x of Right t-> [t]; Left _-> [];)
+
+-- | Walk through the document, replacing calls of macros with the expanded RHS.
+--   Additionally returns the active symbol table after processing.
+macroPassReturningSymTab
+          :: [(String,String)]  -- ^ Pre-defined symbols and their values
+          -> BoolOptions        -- ^ Options that alter processing style
+          -> [(Posn,String)]    -- ^ The input file content
+          -> IO (String,[(String,String)])
+                                -- ^ The file and symbol table after processing
+macroPassReturningSymTab syms options =
+    fmap (mapFst (safetail              -- to remove extra "\n" inserted below
+                 . concat)
+         . walk)
+    . macroProcess (pragma options) (layout options) (lang options)
+                   (preDefine options syms)
+    . tokenise (stripEol options) (stripC89 options)
+               (ansi options) (lang options)
+    . ((noPos,""):)     -- ensure recognition of "\n#" at start of file
+  where
+    safetail [] = []
+    safetail (_:xs) = xs
+    walk (Right x: rest) = let (xs,   foo) = walk rest
+                           in  (x:xs, foo)
+    walk (Left  x: [])   =     ( [] , simplifyHashDefines (flattenST x) )
+    walk (Left  x: rest) = walk rest
+    mapFst f (a,b) = (f a, b)
+
+
+-- | Turn command-line definitions (from @-D@) into 'HashDefine's.
+preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine
+preDefine options defines =
+    foldr (insertST . defineMacro options . (\ (s,d)-> s++" "++d))
+          emptyST defines
+
+-- | Turn a string representing a macro definition into a 'HashDefine'.
+defineMacro :: BoolOptions -> String -> (String,HashDefine)
+defineMacro opts s =
+    let (Cmd (Just hd):_) = tokenise True True (ansi opts) (lang opts)
+                                     [(noPos,"\n#define "++s++"\n")]
+    in (name hd, hd)
+
+
+-- | Trundle through the document, one word at a time, using the WordStyle
+--   classification introduced by 'tokenise' to decide whether to expand a
+--   word or macro.  Encountering a \#define or \#undef causes that symbol to
+--   be overwritten in the symbol table.  Any other remaining cpp directives
+--   are discarded and replaced with blanks, except for \#line markers.
+--   All valid identifiers are checked for the presence of a definition
+--   of that name in the symbol table, and if so, expanded appropriately.
+--   (Bool arguments are: keep pragmas?  retain layout?  haskell language?)
+--   The result lazily intersperses output text with symbol tables.  Lines
+--   are emitted as they are encountered.  A symbol table is emitted after
+--   each change to the defined symbols, and always at the end of processing.
+macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle]
+             -> IO [Either (SymTab HashDefine) String]
+macroProcess _ _ _ st        []          = return [Left st]
+macroProcess p y l st (Other x: ws)      = emit x    $ macroProcess p y l st ws
+macroProcess p y l st (Cmd Nothing: ws)  = emit "\n" $ macroProcess p y l st ws
+macroProcess p y l st (Cmd (Just (LineDrop x)): ws)
+                                         = emit "\n" $
+                                           emit x    $ macroProcess p y l st ws
+macroProcess pragma y l st (Cmd (Just (Pragma x)): ws)
+               | pragma    = emit "\n" $ emit x $ macroProcess pragma y l st ws
+               | otherwise = emit "\n" $          macroProcess pragma y l st ws
+macroProcess p layout lang st (Cmd (Just hd): ws) =
+    let n = 1 + linebreaks hd
+        newST = insertST (name hd, hd) st
+    in
+    emit (replicate n '\n') $
+    emitSymTab newST $
+    macroProcess p layout lang newST ws
+macroProcess pr layout lang st (Ident p x: ws) =
+    case x of
+      "__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws
+      "__LINE__" -> emit (show (lineno p))  $ macroProcess pr layout lang st ws
+      "__DATE__" -> do w <- return .
+                            formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
+                            =<< toCalendarTime =<< getClockTime
+                       emit w $ macroProcess pr layout lang st ws
+      "__TIME__" -> do w <- return .
+                            formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
+                            =<< toCalendarTime =<< getClockTime
+                       emit w $ macroProcess pr layout lang st ws
+      _ ->
+        case lookupST x st of
+            Nothing -> emit x $ macroProcess pr layout lang st ws
+            Just hd ->
+                case hd of
+                    AntiDefined {name=n} -> emit n $
+                                            macroProcess pr layout lang st ws
+                    SymbolReplacement {replacement=r} ->
+                        let r' = if layout then r else filter (/='\n') r in
+                        -- one-level expansion only:
+                        -- emit r' $ macroProcess layout st ws
+                        -- multi-level expansion:
+                        macroProcess pr layout lang st
+                                     (tokenise True True False lang [(p,r')]
+                                      ++ ws)
+                    MacroExpansion {} ->
+                        case parseMacroCall p ws of
+                            Nothing -> emit x $
+                                       macroProcess pr layout lang st ws
+                            Just (args,ws') ->
+                                if length args /= length (arguments hd) then
+                                     emit x $ macroProcess pr layout lang st ws
+                                else do args' <- mapM (fmap (concat.onlyRights)
+                                                       . macroProcess pr layout
+                                                                        lang st)
+                                                      args
+                                        -- one-level expansion only:
+                                        -- emit (expandMacro hd args' layout) $
+                                        --         macroProcess layout st ws'
+                                        -- multi-level expansion:
+                                        macroProcess pr layout lang st
+                                            (tokenise True True False lang
+                                               [(p,expandMacro hd args' layout)]
+                                            ++ ws')
+
+-- | Useful helper function.
+emit :: a -> IO [Either b a] -> IO [Either b a]
+emit x io = do xs <- unsafeInterleaveIO io
+               return (Right x:xs)
+-- | Useful helper function.
+emitSymTab :: b -> IO [Either b a] -> IO [Either b a]
+emitSymTab x io = do xs <- unsafeInterleaveIO io
+                     return (Left x:xs)
+ examples/CppHs/Language/Preprocessor/Cpphs/Options.hs view
@@ -0,0 +1,156 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Options
+-- Copyright   :  2006 Malcolm Wallace
+-- Licence     :  LGPL
+--
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+--
+-- This module deals with Cpphs options and parsing them
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs.Options
+  ( CpphsOptions(..)
+  , BoolOptions(..)
+  , parseOptions
+  , defaultCpphsOptions
+  , defaultBoolOptions
+  , trailing
+  ) where
+
+import Data.Maybe
+import Data.List (isPrefixOf)
+
+-- | Cpphs options structure.
+data CpphsOptions = CpphsOptions 
+    { infiles   :: [FilePath]
+    , outfiles  :: [FilePath]
+    , defines   :: [(String,String)]
+    , includes  :: [String]
+    , preInclude:: [FilePath]   -- ^ Files to \#include before anything else
+    , boolopts  :: BoolOptions
+    } deriving (Show)
+
+-- | Default options.
+defaultCpphsOptions :: CpphsOptions
+defaultCpphsOptions = CpphsOptions { infiles = [], outfiles = []
+                                   , defines = [], includes = []
+                                   , preInclude = []
+                                   , boolopts = defaultBoolOptions }
+
+-- | Options representable as Booleans.
+data BoolOptions = BoolOptions
+    { macros    :: Bool  -- ^ Leave \#define and \#undef in output of ifdef?
+    , locations :: Bool  -- ^ Place \#line droppings in output?
+    , hashline  :: Bool  -- ^ Write \#line or {-\# LINE \#-} ?
+    , pragma    :: Bool  -- ^ Keep \#pragma in final output?
+    , stripEol  :: Bool  -- ^ Remove C eol (\/\/) comments everywhere?
+    , stripC89  :: Bool  -- ^ Remove C inline (\/**\/) comments everywhere?
+    , lang      :: Bool  -- ^ Lex input as Haskell code?
+    , ansi      :: Bool  -- ^ Permit stringise \# and catenate \#\# operators?
+    , layout    :: Bool  -- ^ Retain newlines in macro expansions?
+    , literate  :: Bool  -- ^ Remove literate markup?
+    , warnings  :: Bool  -- ^ Issue warnings?
+    } deriving (Show)
+
+-- | Default settings of boolean options.
+defaultBoolOptions :: BoolOptions
+defaultBoolOptions = BoolOptions { macros   = True,   locations = True
+                                 , hashline = True,   pragma    = False
+                                 , stripEol = False,  stripC89  = False
+                                 , lang     = True,   ansi      = False
+                                 , layout   = False,  literate  = False
+                                 , warnings = True }
+
+-- | Raw command-line options.  This is an internal intermediate data
+--   structure, used during option parsing only.
+data RawOption
+    = NoMacro
+    | NoLine
+    | LinePragma
+    | Pragma
+    | Text
+    | Strip
+    | StripEol
+    | Ansi
+    | Layout
+    | Unlit
+    | SuppressWarnings
+    | Macro (String,String)
+    | Path String
+    | PreInclude FilePath
+    | IgnoredForCompatibility
+      deriving (Eq, Show)
+
+flags :: [(String, RawOption)]
+flags = [ ("--nomacro", NoMacro)
+        , ("--noline",  NoLine)
+        , ("--linepragma", LinePragma)
+        , ("--pragma",  Pragma)
+        , ("--text",    Text)
+        , ("--strip",   Strip)
+        , ("--strip-eol",  StripEol)
+        , ("--hashes",  Ansi)
+        , ("--layout",  Layout)
+        , ("--unlit",   Unlit)
+        , ("--nowarn",  SuppressWarnings)
+        ]
+
+-- | Parse a single raw command-line option.  Parse failure is indicated by
+--   result Nothing.
+rawOption :: String -> Maybe RawOption
+rawOption x | isJust a = a
+    where a = lookup x flags
+rawOption ('-':'D':xs) = Just $ Macro (s, if null d then "1" else tail d)
+    where (s,d) = break (=='=') xs
+rawOption ('-':'U':xs) = Just $ IgnoredForCompatibility
+rawOption ('-':'I':xs) = Just $ Path $ trailing "/\\" xs
+rawOption xs | "--include="`isPrefixOf`xs
+            = Just $ PreInclude (drop 10 xs)
+rawOption _ = Nothing
+
+-- | Trim trailing elements of the second list that match any from
+--   the first list.  Typically used to remove trailing forward\/back
+--   slashes from a directory path.
+trailing :: (Eq a) => [a] -> [a] -> [a]
+trailing xs = reverse . dropWhile (`elem`xs) . reverse
+
+-- | Convert a list of RawOption to a BoolOptions structure.
+boolOpts :: [RawOption] -> BoolOptions
+boolOpts opts =
+  BoolOptions
+    { macros    = not (NoMacro `elem` opts)
+    , locations = not (NoLine  `elem` opts)
+    , hashline  = not (LinePragma `elem` opts)
+    , pragma    =      Pragma  `elem` opts
+    , stripEol  =      StripEol`elem` opts
+    , stripC89  =      StripEol`elem` opts || Strip `elem` opts
+    , lang      = not (Text    `elem` opts)
+    , ansi      =      Ansi    `elem` opts
+    , layout    =      Layout  `elem` opts
+    , literate  =      Unlit   `elem` opts
+    , warnings  = not (SuppressWarnings `elem` opts)
+    }
+
+-- | Parse all command-line options.
+parseOptions :: [String] -> Either String CpphsOptions
+parseOptions xs = f ([], [], []) xs
+  where
+    f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs
+    f (opts, ins, outs) (x@('-':_):xs) = case rawOption x of
+                                           Nothing -> Left x
+                                           Just a  -> f (a:opts, ins, outs) xs
+    f (opts, ins, outs) (x:xs) = f (opts, normalise x:ins, outs) xs
+    f (opts, ins, outs) []     =
+        Right CpphsOptions { infiles  = reverse ins
+                           , outfiles = reverse outs
+                           , defines  = [ x | Macro x <- reverse opts ]
+                           , includes = [ x | Path x  <- reverse opts ]
+                           , preInclude=[ x | PreInclude x <- reverse opts ]
+                           , boolopts = boolOpts opts
+                           }
+    normalise ('/':'/':filepath) = normalise ('/':filepath)
+    normalise (x:filepath)       = x:normalise filepath
+    normalise []                 = []
+ examples/CppHs/Language/Preprocessor/Cpphs/Position.hs view
@@ -0,0 +1,106 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Position
+-- Copyright   :  2000-2004 Malcolm Wallace
+-- Licence     :  LGPL
+--
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+--
+-- Simple file position information, with recursive inclusion points.
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs.Position
+  ( Posn(..)
+  , newfile
+  , addcol, newline, tab, newlines, newpos
+  , cppline, haskline, cpp2hask
+  , filename, lineno, directory
+  , cleanPath
+  ) where
+
+import Data.List (isPrefixOf)
+
+-- | Source positions contain a filename, line, column, and an
+--   inclusion point, which is itself another source position,
+--   recursively.
+data Posn = Pn String !Int !Int (Maybe Posn)
+        deriving (Eq)
+
+instance Show Posn where
+      showsPrec _ (Pn f l c i) = showString f .
+                                 showString "  at line " . shows l .
+                                 showString " col " . shows c .
+                                 ( case i of
+                                    Nothing -> id
+                                    Just p  -> showString "\n    used by  " .
+                                               shows p )
+
+-- | Constructor.  Argument is filename.
+newfile :: String -> Posn
+newfile name = Pn (cleanPath name) 1 1 Nothing
+
+-- | Increment column number by given quantity.
+addcol :: Int -> Posn -> Posn
+addcol n (Pn f r c i) = Pn f r (c+n) i
+
+-- | Increment row number, reset column to 1.
+newline :: Posn -> Posn
+--newline (Pn f r _ i) = Pn f (r+1) 1 i
+newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i
+
+-- | Increment column number, tab stops are every 8 chars.
+tab     :: Posn -> Posn
+tab     (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i
+
+-- | Increment row number by given quantity.
+newlines :: Int -> Posn -> Posn
+newlines n (Pn f r _ i) = Pn f (r+n) 1 i
+
+-- | Update position with a new row, and possible filename.
+newpos :: Int -> Maybe String -> Posn -> Posn
+newpos r Nothing  (Pn f _ c i) = Pn f r c i
+newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i
+newpos r (Just f)       (Pn _ _ c i) = Pn f r c i
+
+-- | Project the line number.
+lineno    :: Posn -> Int
+-- | Project the filename.
+filename  :: Posn -> String
+-- | Project the directory of the filename.
+directory :: Posn -> FilePath
+
+lineno    (Pn _ r _ _) = r
+filename  (Pn f _ _ _) = f
+directory (Pn f _ _ _) = dirname f
+
+
+-- | cpp-style printing of file position
+cppline :: Posn -> String
+cppline (Pn f r _ _) = "#line "++show r++" "++show f
+
+-- | haskell-style printing of file position
+haskline :: Posn -> String
+haskline (Pn f r _ _) = "{-# LINE "++show r++" "++show f++" #-}"
+
+-- | Conversion from a cpp-style "#line" to haskell-style pragma.
+cpp2hask :: String -> String
+cpp2hask line | "#line" `isPrefixOf` line = "{-# LINE "
+                                            ++unwords (tail (words line))
+                                            ++" #-}"
+              | otherwise = line
+
+-- | Strip non-directory suffix from file name (analogous to the shell
+--   command of the same name).
+dirname :: String -> String
+dirname  = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse
+  where safetail [] = []
+        safetail (_:x) = x
+
+-- | Sigh.  Mixing Windows filepaths with unix is bad.  Make sure there is a
+--   canonical path separator.
+cleanPath :: FilePath -> FilePath
+cleanPath [] = []
+cleanPath ('\\':cs) = '/': cleanPath cs
+cleanPath (c:cs)    = c:   cleanPath cs
+ examples/CppHs/Language/Preprocessor/Cpphs/ReadFirst.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  ReadFirst
+-- Copyright   :  2004 Malcolm Wallace
+-- Licence     :  LGPL
+-- 
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+--
+-- Read the first file that matches in a list of search paths.
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs.ReadFirst
+  ( readFirst
+  ) where
+
+import System.IO        (hPutStrLn, stderr)
+import System.Directory (doesFileExist)
+import Data.List      (intersperse)
+import Control.Monad     (when)
+import Language.Preprocessor.Cpphs.Position  (Posn,directory,cleanPath)
+
+-- | Attempt to read the given file from any location within the search path.
+--   The first location found is returned, together with the file content.
+--   (The directory of the calling file is always searched first, then
+--    the current directory, finally any specified search path.)
+readFirst :: String             -- ^ filename
+        -> Posn                 -- ^ inclusion point
+        -> [String]             -- ^ search path
+        -> Bool                 -- ^ report warnings?
+        -> IO ( FilePath
+              , String
+              )                 -- ^ discovered filepath, and file contents
+
+readFirst name demand path warn =
+    case name of
+       '/':nm -> try nm   [""]
+       _      -> try name (cons dd (".":path))
+  where
+    dd = directory demand
+    cons x xs = if null x then xs else x:xs
+    try name [] = do
+        when warn $
+          hPutStrLn stderr ("Warning: Can't find file \""++name
+                           ++"\" in directories\n\t"
+                           ++concat (intersperse "\n\t" (cons dd (".":path)))
+                           ++"\n  Asked for by: "++show demand)
+        return ("missing file: "++name,"")
+    try name (p:ps) = do
+        let file = cleanPath p++'/':cleanPath name
+        ok <- doesFileExist file
+        if not ok then try name ps
+          else do content <- readFile file
+                  return (file,content)
+ examples/CppHs/Language/Preprocessor/Cpphs/RunCpphs.hs view
@@ -0,0 +1,82 @@+{-
+-- The main program for cpphs, a simple C pre-processor written in Haskell.
+
+-- Copyright (c) 2004 Malcolm Wallace
+-- This file is LGPL (relicensed from the GPL by Malcolm Wallace, October 2011).
+-}
+module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs
+                                            , runCpphsPass1
+                                            , runCpphsPass2
+                                            , runCpphsReturningSymTab
+                                            ) where
+
+import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef)
+import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab)
+import Language.Preprocessor.Cpphs.Options  (CpphsOptions(..), BoolOptions(..)
+                                            ,trailing)
+import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise)
+import Language.Preprocessor.Cpphs.Position (cleanPath, Posn)
+import Language.Preprocessor.Unlit as Unlit (unlit)
+
+
+runCpphs :: CpphsOptions -> FilePath -> String -> IO String
+runCpphs options filename input = do
+  pass1 <- runCpphsPass1 options filename input
+  runCpphsPass2 (boolopts options) (defines options) filename pass1
+
+runCpphsPass1 :: CpphsOptions -> FilePath -> String -> IO [(Posn,String)]
+runCpphsPass1 options' filename input = do
+  let options= options'{ includes= map (trailing "\\/") (includes options') }
+  let bools  = boolopts options
+      preInc = case preInclude options of
+                 [] -> ""
+                 is -> concatMap (\f->"#include \""++f++"\"\n") is 
+                       ++ "#line 1 \""++cleanPath filename++"\"\n"
+
+  pass1 <- cppIfdef filename (defines options) (includes options) bools
+                    (preInc++input)
+  return pass1
+
+runCpphsPass2 :: BoolOptions -> [(String,String)] -> FilePath -> [(Posn,String)] -> IO String
+runCpphsPass2 bools defines filename pass1 = do
+  pass2 <- macroPass defines bools pass1
+  let result= if not (macros bools)
+              then if   stripC89 bools || stripEol bools
+                   then concatMap deWordStyle $
+                        tokenise (stripEol bools) (stripC89 bools)
+                                 (ansi bools) (lang bools) pass1
+                   else unlines (map snd pass1)
+              else pass2
+      pass3 = if literate bools then Unlit.unlit filename else id
+  return (pass3 result)
+
+runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String
+             -> IO (String,[(String,String)])
+runCpphsReturningSymTab options' filename input = do
+  let options= options'{ includes= map (trailing "\\/") (includes options') }
+  let bools  = boolopts options
+      preInc = case preInclude options of
+                 [] -> ""
+                 is -> concatMap (\f->"#include \""++f++"\"\n") is 
+                       ++ "#line 1 \""++cleanPath filename++"\"\n"
+  (pass2,syms) <-
+      if macros bools then do
+          pass1 <- cppIfdef filename (defines options) (includes options)
+                            bools (preInc++input)
+          macroPassReturningSymTab (defines options) bools pass1
+      else do
+          pass1 <- cppIfdef filename (defines options) (includes options)
+                            bools{macros=True} (preInc++input)
+          (_,syms) <- macroPassReturningSymTab (defines options) bools pass1
+          pass1 <- cppIfdef filename (defines options) (includes options)
+                            bools (preInc++input)
+          let result = if   stripC89 bools || stripEol bools
+                       then concatMap deWordStyle $
+                            tokenise (stripEol bools) (stripC89 bools)
+                                     (ansi bools) (lang bools) pass1
+                       else init $ unlines (map snd pass1)
+          return (result,syms)
+
+  let pass3 = if literate bools then Unlit.unlit filename else id
+  return (pass3 pass2, syms)
+
+ examples/CppHs/Language/Preprocessor/Cpphs/SymTab.hs view
@@ -0,0 +1,92 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  SymTab
+-- Copyright   :  2000-2004 Malcolm Wallace
+-- Licence     :  LGPL
+-- 
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  Stable
+-- Portability :  All
+--
+-- Symbol Table, based on index trees using a hash on the key.
+--   Keys are always Strings.  Stored values can be any type.
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs.SymTab
+  ( SymTab
+  , emptyST
+  , insertST
+  , deleteST
+  , lookupST
+  , definedST
+  , flattenST
+  , IndTree
+  ) where
+
+-- | Symbol Table.  Stored values are polymorphic, but the keys are
+--   always strings.
+type SymTab v = IndTree [(String,v)]
+
+emptyST   :: SymTab v
+insertST  :: (String,v) -> SymTab v -> SymTab v
+deleteST  :: String -> SymTab v -> SymTab v
+lookupST  :: String -> SymTab v -> Maybe v
+definedST :: String -> SymTab v -> Bool
+flattenST :: SymTab v -> [v]
+
+emptyST           = itgen maxHash []
+insertST (s,v) ss = itiap (hash s) ((s,v):)    ss id
+deleteST  s    ss = itiap (hash s) (filter ((/=s).fst)) ss id
+lookupST  s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
+                    in if null vs then Nothing
+                       else (Just . snd . head) vs
+definedST s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
+                    in (not . null) vs
+flattenST      ss = itfold (map snd) (++) ss
+
+
+----
+-- | Index Trees (storing indexes at nodes).
+
+data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)
+     deriving Show
+
+itgen :: Int -> a -> IndTree a
+itgen 1 x = Leaf x
+itgen n x =
+  let n' = n `div` 2
+  in Fork n' (itgen n' x) (itgen (n-n') x)
+
+itiap :: --Eval a =>
+         Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
+itiap _ f (Leaf x)       k = let fx = f x in {-seq fx-} (k (Leaf fx))
+itiap i f (Fork n lt rt) k =
+  if i<n then
+       itiap i f lt $ \lt' -> k (Fork n lt' rt)
+  else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt')
+
+itind :: Int -> IndTree a -> a
+itind _ (Leaf x) = x
+itind i (Fork n lt rt) = if i<n then itind i lt else itind (i-n) rt
+
+itfold :: (a->b) -> (b->b->b) -> IndTree a -> b
+itfold leaf _fork (Leaf x) = leaf x
+itfold leaf  fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r)
+
+----
+-- Hash values
+
+maxHash :: Int -- should be prime
+maxHash = 101
+
+class Hashable a where
+    hashWithMax :: Int -> a -> Int
+    hash        :: a -> Int
+    hash = hashWithMax maxHash
+
+instance Enum a => Hashable [a] where
+    hashWithMax m = h 0
+        where h a []     = a
+              h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs
+
+----
+ examples/CppHs/Language/Preprocessor/Cpphs/Tokenise.hs view
@@ -0,0 +1,281 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Tokenise
+-- Copyright   :  2004 Malcolm Wallace
+-- Licence     :  LGPL
+--
+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability   :  experimental
+-- Portability :  All
+--
+-- The purpose of this module is to lex a source file (language
+-- unspecified) into tokens such that cpp can recognise a replaceable
+-- symbol or macro-use, and do the right thing.
+-----------------------------------------------------------------------------
+
+module Language.Preprocessor.Cpphs.Tokenise
+  ( linesCpp
+  , reslash
+  , tokenise
+  , WordStyle(..)
+  , deWordStyle
+  , parseMacroCall
+  ) where
+
+import Data.Char
+import Language.Preprocessor.Cpphs.HashDefine
+import Language.Preprocessor.Cpphs.Position
+
+-- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp.
+--   The main difference is that in Cpp mode we should recognise line
+--   continuation characters.
+data Mode = Haskell | Cpp
+
+-- | linesCpp is, broadly speaking, Prelude.lines, except that
+--   on a line beginning with a \#, line continuation characters are
+--   recognised.  In a line continuation, the newline character is
+--   preserved, but the backslash is not.
+linesCpp :: String -> [String]
+linesCpp  []                 = []
+linesCpp (x:xs) | x=='#'     = tok Cpp     ['#'] xs
+                | otherwise  = tok Haskell [] (x:xs)
+  where
+    tok Cpp   acc ('\\':'\n':ys)   = tok Cpp ('\n':acc) ys
+    tok _     acc ('\n':'#':ys)    = reverse acc: tok Cpp ['#'] ys
+    tok _     acc ('\n':ys)        = reverse acc: tok Haskell [] ys
+    tok _     acc []               = reverse acc: []
+    tok mode  acc (y:ys)           = tok mode (y:acc) ys
+
+-- | Put back the line-continuation characters.
+reslash :: String -> String
+reslash ('\n':xs) = '\\':'\n':reslash xs
+reslash (x:xs)    = x: reslash xs
+reslash   []      = []
+
+----
+-- | Submodes are required to deal correctly with nesting of lexical
+--   structures.
+data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle)
+             | String Char | LineComment | NestComment Int
+             | CComment | CLineComment
+
+-- | Each token is classified as one of Ident, Other, or Cmd:
+--   * Ident is a word that could potentially match a macro name.
+--   * Cmd is a complete cpp directive (\#define etc).
+--   * Other is anything else.
+data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine)
+  deriving (Eq,Show)
+other :: Posn -> String -> WordStyle
+other _ s = Other s
+
+deWordStyle :: WordStyle -> String
+deWordStyle (Ident _ i) = i
+deWordStyle (Other i)   = i
+deWordStyle (Cmd _)     = "\n"
+
+-- | tokenise is, broadly-speaking, Prelude.words, except that:
+--    * the input is already divided into lines
+--    * each word-like "token" is categorised as one of {Ident,Other,Cmd}
+--    * \#define's are parsed and returned out-of-band using the Cmd variant
+--    * All whitespace is preserved intact as tokens.
+--    * C-comments are converted to white-space (depending on first param)
+--    * Parens and commas are tokens in their own right.
+--    * Any cpp line continuations are respected.
+--   No errors can be raised.
+--   The inverse of tokenise is (concatMap deWordStyle).
+tokenise :: Bool -> Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle]
+tokenise _        _             _    _     [] = []
+tokenise stripEol stripComments ansi lang ((pos,str):pos_strs) =
+    (if lang then haskell else plaintext) Any [] pos pos_strs str
+ where
+    -- rules to lex Haskell
+  haskell :: SubMode -> String -> Posn -> [(Posn,String)]
+             -> String -> [WordStyle]
+  haskell Any acc p ls ('\n':'#':xs)      = emit acc $  -- emit "\n" $
+                                            cpp Any haskell [] [] p ls xs
+    -- warning: non-maximal munch on comment
+  haskell Any acc p ls ('-':'-':xs)       = emit acc $
+                                            haskell LineComment "--" p ls xs
+  haskell Any acc p ls ('{':'-':xs)       = emit acc $
+                                            haskell (NestComment 0) "-{" p ls xs
+  haskell Any acc p ls ('/':'*':xs)
+                          | stripComments = emit acc $
+                                            haskell CComment "  " p ls xs
+  haskell Any acc p ls ('/':'/':xs)
+                          | stripEol      = emit acc $
+                                            haskell CLineComment "  " p ls xs
+  haskell Any acc p ls ('"':xs)           = emit acc $
+                                            haskell (String '"') ['"'] p ls xs
+  haskell Any acc p ls ('\'':'\'':xs)     = emit acc $ -- TH type quote
+                                            haskell Any "''" p ls xs
+  haskell Any acc p ls ('\'':xs@('\\':_)) = emit acc $ -- escaped char literal
+                                            haskell (String '\'') "'" p ls xs
+  haskell Any acc p ls ('\'':x:'\'':xs)   = emit acc $ -- character literal
+                                            emit ['\'', x, '\''] $
+                                            haskell Any [] p ls xs
+  haskell Any acc p ls ('\'':xs)          = emit acc $ -- TH name quote
+                                            haskell Any "'" p ls xs
+  haskell Any acc p ls (x:xs) | single x  = emit acc $ emit [x] $
+                                            haskell Any [] p ls xs
+  haskell Any acc p ls (x:xs) | space x   = emit acc $
+                                            haskell (Pred space other) [x]
+                                                                        p ls xs
+  haskell Any acc p ls (x:xs) | symbol x  = emit acc $
+                                            haskell (Pred symbol other) [x]
+                                                                        p ls xs
+ -- haskell Any [] p ls (x:xs) | ident0 x  = id $
+  haskell Any acc p ls (x:xs) | ident0 x  = emit acc $
+                                            haskell (Pred ident1 Ident) [x]
+                                                                        p ls xs
+  haskell Any acc p ls (x:xs)             = haskell Any (x:acc) p ls xs
+
+  haskell pre@(Pred pred ws) acc p ls (x:xs)
+                        | pred x    = haskell pre (x:acc) p ls xs
+  haskell (Pred _ ws) acc p ls xs   = ws p (reverse acc):
+                                      haskell Any [] p ls xs
+  haskell (String c) acc p ls ('\\':x:xs)
+                        | x=='\\'   = haskell (String c) ('\\':'\\':acc) p ls xs
+                        | x==c      = haskell (String c) (c:'\\':acc) p ls xs
+  haskell (String c) acc p ls (x:xs)
+                        | x==c      = emit (c:acc) $ haskell Any [] p ls xs
+                        | otherwise = haskell (String c) (x:acc) p ls xs
+  haskell LineComment acc p ls xs@('\n':_) = emit acc $ haskell Any [] p ls xs
+  haskell LineComment acc p ls (x:xs)      = haskell LineComment (x:acc) p ls xs
+  haskell (NestComment n) acc p ls ('{':'-':xs)
+                                    = haskell (NestComment (n+1))
+                                                            ("-{"++acc) p ls xs
+  haskell (NestComment 0) acc p ls ('-':'}':xs)
+                                    = emit ("}-"++acc) $ haskell Any [] p ls xs
+  haskell (NestComment n) acc p ls ('-':'}':xs)
+                                    = haskell (NestComment (n-1))
+                                                            ("}-"++acc) p ls xs
+  haskell (NestComment n) acc p ls (x:xs) = haskell (NestComment n) (x:acc)
+                                                                        p ls xs
+  haskell CComment acc p ls ('*':'/':xs)  = emit ("  "++acc) $
+                                            haskell Any [] p ls xs
+  haskell CComment acc p ls (x:xs)        = haskell CComment (white x:acc) p ls xs
+  haskell CLineComment acc p ls xs@('\n':_)= emit acc $ haskell Any [] p ls xs
+  haskell CLineComment acc p ls (_:xs)    = haskell CLineComment (' ':acc)
+                                                                       p ls xs
+  haskell mode acc _ ((p,l):ls) []        = haskell mode acc p ls ('\n':l)
+  haskell _    acc _ [] []                = emit acc $ []
+
+  -- rules to lex Cpp
+  cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)]
+                     -> String -> [WordStyle])
+         -> String -> [String] -> Posn -> [(Posn,String)]
+         -> String -> [WordStyle]
+  cpp mode next word line pos remaining input =
+    lexcpp mode word line remaining input
+   where
+    lexcpp Any w l ls ('/':'*':xs)   = lexcpp (NestComment 0) "" (w*/*l) ls xs
+    lexcpp Any w l ls ('/':'/':xs)   = lexcpp LineComment "  " (w*/*l) ls xs
+    lexcpp Any w l ((p,l'):ls) ('\\':[])  = cpp Any next [] ("\n":w*/*l) p ls l'
+    lexcpp Any w l ls ('\\':'\n':xs) = lexcpp Any [] ("\n":w*/*l) ls xs
+    lexcpp Any w l ls xs@('\n':_)    = Cmd (parseHashDefine ansi
+                                                           (reverse (w*/*l))):
+                                       next Any [] pos ls xs
+ -- lexcpp Any w l ls ('"':xs)     = lexcpp (String '"') ['"'] (w*/*l) ls xs
+ -- lexcpp Any w l ls ('\'':xs)    = lexcpp (String '\'') "'"  (w*/*l) ls xs
+    lexcpp Any w l ls ('"':xs)       = lexcpp Any [] ("\"":(w*/*l)) ls xs
+    lexcpp Any w l ls ('\'':xs)      = lexcpp Any [] ("'": (w*/*l)) ls xs
+    lexcpp Any [] l ls (x:xs)
+                    | ident0 x  = lexcpp (Pred ident1 Ident) [x] l ls xs
+ -- lexcpp Any w l ls (x:xs) | ident0 x  = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs
+    lexcpp Any w l ls (x:xs)
+                    | single x  = lexcpp Any [] ([x]:w*/*l) ls xs
+                    | space x   = lexcpp (Pred space other) [x] (w*/*l) ls xs
+                    | symbol x  = lexcpp (Pred symbol other) [x] (w*/*l) ls xs
+                    | otherwise = lexcpp Any (x:w) l ls xs
+    lexcpp pre@(Pred pred _) w l ls (x:xs)
+                    | pred x    = lexcpp pre (x:w) l ls xs
+    lexcpp (Pred _ _) w l ls xs = lexcpp Any [] (w*/*l) ls xs
+    lexcpp (String c) w l ls ('\\':x:xs)
+                    | x=='\\'   = lexcpp (String c) ('\\':'\\':w) l ls xs
+                    | x==c      = lexcpp (String c) (c:'\\':w) l ls xs
+    lexcpp (String c) w l ls (x:xs)
+                    | x==c      = lexcpp Any [] ((c:w)*/*l) ls xs
+                    | otherwise = lexcpp (String c) (x:w) l ls xs
+    lexcpp LineComment w l ((p,l'):ls) ('\\':[])
+                             = cpp LineComment next [] (('\n':w)*/*l) pos ls l'
+    lexcpp LineComment w l ls ('\\':'\n':xs)
+                                = lexcpp LineComment [] (('\n':w)*/*l) ls xs
+    lexcpp LineComment w l ls xs@('\n':_) = lexcpp Any w l ls xs
+    lexcpp LineComment w l ls (_:xs)      = lexcpp LineComment (' ':w) l ls xs
+    lexcpp (NestComment _) w l ls ('*':'/':xs)
+                                          = lexcpp Any [] (w*/*l) ls xs
+    lexcpp (NestComment n) w l ls (x:xs)  = lexcpp (NestComment n) (white x:w) l
+                                                                        ls xs
+    lexcpp mode w l ((p,l'):ls) []        = cpp mode next w l p ls ('\n':l')
+    lexcpp _    _ _ []          []        = []
+
+    -- rules to lex non-Haskell, non-cpp text
+  plaintext :: SubMode -> String -> Posn -> [(Posn,String)]
+            -> String -> [WordStyle]
+  plaintext Any acc p ls ('\n':'#':xs)  = emit acc $  -- emit "\n" $
+                                          cpp Any plaintext [] [] p ls xs
+  plaintext Any acc p ls ('/':'*':xs)
+                           | stripComments = emit acc $
+                                             plaintext CComment "  " p ls xs
+  plaintext Any acc p ls ('/':'/':xs)
+                                | stripEol = emit acc $
+                                             plaintext CLineComment "  " p ls xs
+  plaintext Any acc p ls (x:xs) | single x = emit acc $ emit [x] $
+                                             plaintext Any [] p ls xs
+  plaintext Any acc p ls (x:xs) | space x  = emit acc $
+                                             plaintext (Pred space other) [x]
+                                                                        p ls xs
+  plaintext Any acc p ls (x:xs) | ident0 x = emit acc $
+                                             plaintext (Pred ident1 Ident) [x]
+                                                                        p ls xs
+  plaintext Any acc p ls (x:xs)            = plaintext Any (x:acc) p ls xs
+  plaintext pre@(Pred pred ws) acc p ls (x:xs)
+                                | pred x   = plaintext pre (x:acc) p ls xs
+  plaintext (Pred _ ws) acc p ls xs        = ws p (reverse acc):
+                                             plaintext Any [] p ls xs
+  plaintext CComment acc p ls ('*':'/':xs) = emit ("  "++acc) $
+                                             plaintext Any [] p ls xs
+  plaintext CComment acc p ls (x:xs)       = plaintext CComment (white x:acc) p ls xs
+  plaintext CLineComment acc p ls xs@('\n':_)
+                                        = emit acc $ plaintext Any [] p ls xs
+  plaintext CLineComment acc p ls (_:xs)= plaintext CLineComment (' ':acc)
+                                                                       p ls xs
+  plaintext mode acc _ ((p,l):ls) []    = plaintext mode acc p ls ('\n':l)
+  plaintext _    acc _ [] []            = emit acc $ []
+
+  -- predicates for lexing Haskell.
+  ident0 x = isAlpha x    || x `elem` "_`"
+  ident1 x = isAlphaNum x || x `elem` "'_`"
+  symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~"
+  single x = x `elem` "(),[];{}"
+  space  x = x `elem` " \t"
+  -- conversion of comment text to whitespace
+  white '\n' = '\n'
+  white '\r' = '\r'
+  white _    = ' '
+  -- emit a token (if there is one) from the accumulator
+  emit ""  = id
+  emit xs  = (Other (reverse xs):)
+  -- add a reversed word to the accumulator
+  "" */* l = l
+  w */* l  = reverse w : l
+  -- help out broken Haskell compilers which need balanced numbers of C
+  -- comments in order to do import chasing :-)  ----->   */*
+
+
+-- | Parse a possible macro call, returning argument list and remaining input
+parseMacroCall :: Posn -> [WordStyle] -> Maybe ([[WordStyle]],[WordStyle])
+parseMacroCall p = call . skip
+  where
+    skip (Other x:xs) | all isSpace x = skip xs
+    skip xss                          = xss
+    call (Other "(":xs)   = (args (0::Int) [] [] . skip) xs
+    call _                = Nothing
+    args 0 w acc (   Other ")" :xs)  = Just (reverse (addone w acc), xs)
+    args 0 w acc (   Other "," :xs)  = args 0     []   (addone w acc) (skip xs)
+    args n w acc (x@(Other "("):xs)  = args (n+1) (x:w)         acc    xs
+    args n w acc (x@(Other ")"):xs)  = args (n-1) (x:w)         acc    xs
+    args n w acc (   Ident _ v :xs)  = args n     (Ident p v:w) acc    xs
+    args n w acc (x@(Other _)  :xs)  = args n     (x:w)         acc    xs
+    args _ _ _   _                   = Nothing
+    addone w acc = reverse (skip w): acc
+ examples/CppHs/Language/Preprocessor/Unlit.hs view
@@ -0,0 +1,72 @@+-- | Part of this code is from "Report on the Programming Language Haskell",
+--   version 1.2, appendix C.
+module Language.Preprocessor.Unlit (unlit) where
+
+import Data.Char
+import Data.List (isPrefixOf)
+
+data Classified = Program String | Blank | Comment
+                | Include Int String | Pre String
+
+classify :: [String] -> [Classified]
+classify []                = []
+classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs
+   where allProg [] = []  -- Should give an error message,
+                          -- but I have no good position information.
+         allProg (('\\':x):xs) |  "end{code}"`isPrefixOf`x = Blank : classify xs
+         allProg (x:xs) = Program x:allProg xs
+classify (('>':x):xs)      = Program (' ':x) : classify xs
+classify (('#':x):xs)      = (case words x of
+                                (line:rest) | all isDigit line
+                                   -> Include (read line) (unwords rest)
+                                _  -> Pre x
+                             ) : classify xs
+--classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs
+classify (x:xs) | all isSpace x = Blank:classify xs
+classify (x:xs)                 = Comment:classify xs
+
+unclassify :: Classified -> String
+unclassify (Program s) = s
+unclassify (Pre s)     = '#':s
+unclassify (Include i f) = '#':' ':show i ++ ' ':f
+unclassify Blank       = ""
+unclassify Comment     = ""
+
+-- | 'unlit' takes a filename (for error reports), and transforms the
+--   given string, to eliminate the literate comments from the program text.
+unlit :: FilePath -> String -> String
+unlit file lhs = (unlines
+                 . map unclassify
+                 . adjacent file (0::Int) Blank
+                 . classify) (inlines lhs)
+
+adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified]
+adjacent file 0 _             (x              :xs) = x : adjacent file 1 x xs -- force evaluation of line number
+adjacent file n y@(Program _) (x@Comment      :xs) = error (message file n "program" "comment")
+adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f    i     y xs
+adjacent file n y@(Program _) (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
+adjacent file n y@Comment     (x@(Program _)  :xs) = error (message file n "comment" "program")
+adjacent file n y@Comment     (x@(Include i f):xs) = x: adjacent f    i     y xs
+adjacent file n y@Comment     (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
+adjacent file n y@Blank       (x@(Include i f):xs) = x: adjacent f    i     y xs
+adjacent file n y@Blank       (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs
+adjacent file n _             (x@next         :xs) = x: adjacent file (n+1) x xs
+adjacent file n _             []                   = []
+
+message :: String -> Int -> String -> String -> String
+message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
+message []     n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
+message file   n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"
+
+
+-- Re-implementation of 'lines', for better efficiency (but decreased laziness).
+-- Also, importantly, accepts non-standard DOS and Mac line ending characters.
+inlines :: String -> [String]
+inlines s = lines' s id
+  where
+  lines' []             acc = [acc []]
+  lines' ('\^M':'\n':s) acc = acc [] : lines' s id      -- DOS
+  lines' ('\^M':s)      acc = acc [] : lines' s id      -- MacOS
+  lines' ('\n':s)       acc = acc [] : lines' s id      -- Unix
+  lines' (c:s)          acc = lines' s (acc . (c:))
+
+ examples/Decl/AmbiguousFields.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE DuplicateRecordFields #-}
+module Decl.AmbiguousFields where
+
+data A = A { x, y :: Int }
+data B = B { x, y :: Int }
+
+f :: A -> Int
+f = x
+
+ examples/Decl/AnnPragma.hs view
@@ -0,0 +1,8 @@+module Decl.AnnPragma where
+{-# ANN module (Just "Hello") #-}
+{-# ANN f (Just "Hello") #-}
+f :: Int -> Int
+f a = a + 1
+
+{-# ANN type A (Just "Hello") #-}
+data A = A
+ examples/Decl/ClosedTypeFamily.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.ClosedTypeFamily where
+
+type family F a where
+  F Int  = Bool
+  F Bool = Char
+  F a    = Bool
+ examples/Decl/CtorOp.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TypeOperators #-}
+module Decl.CtorOp where
+
+data a :+: b = a :+: b
+
+data (a :!: b) c = a c :!: b c
+
+data ((:-:) a) b = a :-: b
+
+data (:*:) a b = a :*: b
+ examples/Decl/DataFamily.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.DataFamily where
+
+data family Array :: * -> *
+
+data instance Array () = UnitArray Int deriving Show
+ examples/Decl/DataType.hs view
@@ -0,0 +1,5 @@+module Decl.DataType where
+
+data EmptyData
+
+data A = B Int | C
+ examples/Decl/DataTypeDerivings.hs view
@@ -0,0 +1,5 @@+module Decl.DataTypeDerivings where
+
+data A = A deriving (Eq, Show)
+data B = B deriving (Eq)
+data C = C deriving Eq
+ examples/Decl/FunBind.hs view
@@ -0,0 +1,4 @@+module Decl.FunBind where
+
+f 0 = 1
+f x = x
+ examples/Decl/FunGuards.hs view
@@ -0,0 +1,5 @@+module Decl.FunGuards where
+
+f 0 = 1
+f x | even x = 0
+    | otherwise = 2
+ examples/Decl/FunctionalDeps.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}
+module Decl.FunctionalDeps where
+
+class C a b | a -> b, b -> a where
+  trf :: a -> b
+
+ examples/Decl/GADT.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE GADTs, KindSignatures #-}
+module Decl.GADT where
+
+data G2 a :: * where
+  G2A :: { g2a :: a, g2b :: Int } -> G2 a
+ examples/Decl/InjectiveTypeFamily.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}
+module Decl.InjectiveTypeFamily where
+
+type family Array a = r | r -> a
+
+type instance Array () = Int
+ examples/Decl/InlinePragma.hs view
@@ -0,0 +1,5 @@+module Decl.InlinePragma where
+
+comp :: (b -> c) -> (a -> b) -> a -> c
+{-# INLINE CONLIKE [~1] comp #-}
+comp f g = \x -> f (g x)
+ examples/Decl/InstanceOverlaps.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE FlexibleInstances #-}
+module Decl.InstanceOverlaps where
+
+data A a = A a
+
+instance {-# OVERLAPPING #-} Show (A String) where
+  show (A a) = a
+instance {-# OVERLAPS #-} Show a => Show (A [a]) where
+  show (A a) = show a
+instance {-# OVERLAPPABLE #-} Show (A a) where
+  show (A _) = "A"
+ examples/Decl/InstanceSpec.hs view
@@ -0,0 +1,7 @@+module Decl.InstanceSpec where
+
+data Foo a = Foo a
+
+instance (Eq a) => Eq (Foo a) where 
+   {-# SPECIALIZE instance Eq (Foo Char) #-}
+   Foo a == Foo b = a == b
+ examples/Decl/LocalBindings.hs view
@@ -0,0 +1,9 @@+module Decl.LocalBindings where
+
+f x = g x
+  where g :: Int -> Int
+        g = id
+        
+f' x | even x = g x
+  where g :: Int -> Int
+        g = id
+ examples/Decl/LocalFixity.hs view
@@ -0,0 +1,6 @@+module Decl.LocalFixity where
+
+x = 1 `f` 2
+  where f :: Int -> Int -> Int
+        f a b = a + b 
+        infixl 6 `f`
+ examples/Decl/MultipleFixity.hs view
@@ -0,0 +1,12 @@+module Decl.MultipleFixity where
+
+f :: Int -> Int -> Int
+f a b = a + b
+
+g = f
+
+infixl 6 `f`, `g`
+
+h = f
+
+infixl 5 `h`
+ examples/Decl/MultipleSigs.hs view
@@ -0,0 +1,6 @@+module Decl.MultipleSigs where
+
+f, g :: Int -> Int -> Int
+f a b = a + b
+
+g = f
+ examples/Decl/OperatorBind.hs view
@@ -0,0 +1,6 @@+module Decl.OperatorBind where
+
+a >< b = a ++ b
+
+(<+>) :: Int -> Int -> Int -> Int
+(a <+> b) c = a + b + c
+ examples/Decl/OperatorDecl.hs view
@@ -0,0 +1,6 @@+module Decl.OperatorDecl where
+
+(-!-) :: Int -> Int -> Int
+(-!-) a b = a + b
+
+test = (-!-) (1 -!- 2) 3
+ examples/Decl/ParamDataType.hs view
@@ -0,0 +1,5 @@+module Decl.ParamDataType where
+
+data A a = B Int | C a
+
+data X a = X a
+ examples/Decl/PatternBind.hs view
@@ -0,0 +1,3 @@+module Decl.PatternBind where
+
+(x,y) | 1 == 1 = (1,2)
+ examples/Decl/PatternSynonym.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE PatternSynonyms #-}
+module Decl.PatternSynonym where
+
+data Type = App String [Type]
+
+pattern Arrow :: Type -> Type -> Type
+pattern Arrow t1 t2 = App "->"    [t1, t2]
+
+
+pattern Int        <- App "Int"   []
+
+pattern Maybe t    <- App "Maybe" [t]
+   where Maybe (App "()" []) = App "Bool" []
+         Maybe t = App "Maybe" [t]
+
+------ this is not supported yet
+-- class ListLike a where
+--   pattern Head :: e -> a e
+--   pattern Tail :: a e -> a e
+
+-- instance ListLike [] where
+--   pattern Head h = h:_
+--   pattern Tail t = _:t
+ examples/Decl/RecordPatternSynonyms.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE PatternSynonyms #-}
+module Decl.RecordPatternSynonyms where
+
+pattern Point {x, y} = (x, y)
+
+r = (0, 0) { x = 1 }
+ examples/Decl/RecordType.hs view
@@ -0,0 +1,3 @@+module Decl.RecordType where
+
+data A = B { valB, extra :: Int, qq :: Double } | C
+ examples/Decl/RewriteRule.hs view
@@ -0,0 +1,3 @@+module Decl.RewriteRule where
+
+{-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs #-}
+ examples/Decl/SpecializePragma.hs view
@@ -0,0 +1,5 @@+module Decl.SpecializePragma where
+
+hammeredLookup :: Ord key => [(key, value)] -> key -> value
+{-# SPECIALIZE hammeredLookup :: [(String, value)] -> String -> value, [(Char, value)] -> Char -> value #-}
+hammeredLookup = undefined
+ examples/Decl/StandaloneDeriving.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE StandaloneDeriving #-}
+module Decl.StandaloneDeriving where
+
+data WrapStr = WrapStr String 
+
+deriving instance Eq WrapStr
+ examples/Decl/TypeClass.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.TypeClass where
+
+class EmptyClass a
+
+class Show a => C a where
+  type X a :: *
+  type X a = Int
+  data Q a :: *
+  
+  f :: a -> String
+  f = show
+
+ examples/Decl/TypeClassMinimal.hs view
@@ -0,0 +1,8 @@+module Decl.TypeClassMinimal where
+
+class Eq' a where
+    (=.=) :: a -> a -> Bool
+    (/.=) :: a -> a -> Bool
+    x =.= y = not (x /.= y)
+    x /.= y = not (x =.= y)
+    {-# MINIMAL (=.=) | (/.=) #-}
+ examples/Decl/TypeFamily.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.TypeFamily where
+
+type family Array a :: *
+
+type instance Array () = Int
+ examples/Decl/TypeFamilyKindSig.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies #-}
+module Decl.TypeFamilyKindSig where
+
+type family Array (a :: *) :: *
+
+type instance Array () = Int
+ examples/Decl/TypeInstance.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeFamilies, InstanceSigs #-}
+module Decl.TypeInstance where
+
+import Decl.TypeClass
+
+data A = A deriving Show
+
+instance C A where
+  type X A = Int
+  data Q A = Bool
+
+  f :: A -> String
+  f A = "XXX"
+
+ examples/Decl/TypeRole.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE RoleAnnotations #-}
+module Decl.TypeRole where
+
+type role Foo representational representational
+data Foo a b = Foo Int
+ examples/Decl/TypeSynonym.hs view
@@ -0,0 +1,3 @@+module Decl.TypeSynonym where
+
+type List = Int
+ examples/Decl/ValBind.hs view
@@ -0,0 +1,3 @@+module Decl.ValBind where
+
+x = 1
+ examples/Expr/ArrowNotation.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE Arrows #-}
+module Expr.ArrowNotation where
+
+import Control.Arrow
+
+addA :: Arrow a => a b Int -> a b Int -> a b Int
+addA f g = proc x -> do
+                y <- f -< x
+                z <- g -< x
+                returnA -< y + z
+ examples/Expr/Case.hs view
@@ -0,0 +1,8 @@+module Expr.Case where
+
+x = 12
+
+a = case x of 1 -> 0
+              _ -> 1
+
+b = case x of { 1 -> 0; _ -> 1 }
+ examples/Expr/DoNotation.hs view
@@ -0,0 +1,15 @@+module Expr.DoNotation where
+
+import Control.Monad.Identity
+
+x1 :: Identity ()
+x1 = return ()
+
+x2 :: Identity ()
+x2 = do return ()
+
+x3 :: Identity ()
+x3 = do { return () }
+
+x4 :: Identity Int
+x4 = do { one <- Identity 1; return (one + 1) }
+ examples/Expr/EmptyCase.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE EmptyCase #-}
+module Expr.EmptyCase where
+
+x = 12
+
+a = case x of 
+
+b = case x of {}
+ examples/Expr/GeneralizedListComp.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE ParallelListComp, 
+             TransformListComp,
+             MonadComprehensions,
+             RecordWildCards #-}
+module Expr.GeneralizedListComp where
+
+import GHC.Exts
+import qualified Data.Map as M
+import Data.Ord (comparing)
+
+data Character = Character
+  { firstName :: String
+  , lastName :: String
+  , birthYear :: Int
+  } deriving (Show, Eq)
+
+friends :: [Character]
+friends = [ Character "Phoebe" "Buffay" 1963
+          , Character "Chandler" "Bing" 1969
+          , Character "Rachel" "Green" 1969
+          , Character "Joey" "Tribbiani" 1967
+          , Character "Monica" "Geller" 1964
+          , Character "Ross" "Geller" 1966
+          ]
+          
+oldest :: Int -> [Character] -> [String]
+oldest k tbl = [ firstName ++ " " ++ lastName
+               | Character{..} <- tbl
+               , then sortWith by birthYear
+               , then take k
+               ]
+ examples/Expr/If.hs view
@@ -0,0 +1,4 @@+module Expr.If where
+
+b = 12
+a = if b > 3 then 1 else 0
+ examples/Expr/ImplicitParams.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ImplicitParams #-}
+
+module Expr.ImplicitParams where
+
+import Data.List
+
+sort' :: (?cmp :: a -> a -> Ordering) => [a] -> [a]
+sort' = sortBy ?cmp
+ examples/Expr/LambdaCase.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE LambdaCase, EmptyCase #-}
+module Expr.LambdaCase where
+
+a = \case 1 -> 0
+          _ -> 1
+
+b = \case { 1 -> 0; _ -> 1 }
+
+c = \case {}
+
+d = \case
+ examples/Expr/ListComp.hs view
@@ -0,0 +1,3 @@+module Expr.ListComp where
+
+ls = [ x+y | x <- [1..5], y <- [1..5]]
+ examples/Expr/MultiwayIf.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MultiWayIf #-}
+module Expr.MultiwayIf where
+
+b = 12
+a = if | b > 3     -> 1
+       | b < -5    -> 2
+       | otherwise -> 3
+ examples/Expr/Negate.hs view
@@ -0,0 +1,4 @@+module Expr.Negate where
+
+y = 1
+x = -y
+ examples/Expr/Operator.hs view
@@ -0,0 +1,5 @@+module Expr.Operator where
+
+x = 1 + 2
+y = (+) 1 2
+z = 1 `mod` 2
+ examples/Expr/ParListComp.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE ParallelListComp #-}
+module Expr.ParListComp where
+
+ls = [ x+y | x <- [1..5] | y <- [1..5]]
+ examples/Expr/ParenName.hs view
@@ -0,0 +1,3 @@+module Expr.ParenName where
+
+a x y = (mod) x y
+ examples/Expr/RecordPuns.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE NamedFieldPuns #-}
+module Expr.RecordPuns where
+
+data Point = Point { x :: Int, y :: Int }
+
+f (Point {y}) = y
+ examples/Expr/RecordWildcards.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE RecordWildCards #-}
+module Expr.RecordWildcards where
+
+data Point = Point { x :: Int, y :: Int }
+
+p1 = let x = 3; y = 4 in Point { x = 1, .. }
+ examples/Expr/RecursiveDo.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE RecursiveDo #-}
+module Expr.RecursiveDo where
+
+justOnes = mdo xs <- Just (1:xs)
+               return (map negate xs)
+
+justOnes' = do rec xs <- Just (1:xs)
+                   return (map negate xs)
+               return xs
+ examples/Expr/Sections.hs view
@@ -0,0 +1,4 @@+module Expr.Sections where
+
+x = (1+)
+y = (+1)
+ examples/Expr/StaticPtr.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE StaticPointers #-}
+module Expr.StaticPtr where
+
+import GHC.StaticPtr
+
+inc :: Int -> Int
+inc x = x + 1
+
+ref1, ref3, ref4 :: StaticPtr Int
+ref2 :: StaticPtr (Int -> Int)
+ref5 :: Int -> StaticPtr Int
+ref1 = static 1
+ref2 = static inc
+ref3 = static (inc 1)
+ref4 = static ((\x -> x + 1) (1 :: Int))
+ref5 y = static (let x = 1 in x)
+ examples/Expr/TupleSections.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TupleSections #-}
+module Expr.TupleSections where
+
+f1 = (1,,)
+f2 = (,1)
+ examples/Expr/UnicodeSyntax.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE UnicodeSyntax #-}
+module Expr.UnicodeSyntax where
+    
+import Data.List.Unicode ((∪))
+
+main ∷ IO ()
+main = print $ [1, 2, 3] ∪ [1, 3, 5]
+ examples/InstanceControl/Control/Instances/Morph.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, MultiParamTypeClasses, FlexibleInstances, PolyKinds, UndecidableInstances, AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables, FlexibleContexts #-}
+
+module Control.Instances.Morph (GenMorph(..), Morph(..)) where
+
+import Control.Instances.ShortestPath
+
+import Control.Monad.Identity
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.List
+import Control.Monad.State
+import Data.Maybe
+import Data.Proxy
+import GHC.TypeLits
+import Control.Instances.TypeLevelPrelude
+
+-- | States that 'm1' can be represented with 'm2'.
+-- That is because 'm2' contains more infromation than 'm1'.
+--
+-- The 'MMorph' relation defines a natural transformation from 'm1' to 'm2'
+-- that keeps the following laws:
+--
+-- > morph (return x)  =  return x
+-- > morph (m >>= f)   =  morph m >>= morph . f
+-- 
+-- It is a reflexive and transitive relation.
+--
+class Morph (m1 :: * -> *) (m2 :: * -> *) where
+  -- | Lifts the first monad into the second.
+  morph :: m1 a -> m2 a
+  
+instance GenMorph DB m1 m2 => Morph m1 m2 where
+  morph = genMorph db
+  
+-- | A generalized version of 'Morph'. Can work on different
+-- rulesets, so this should be used if the ruleset is to be extended.
+class GenMorph db (m1 :: * -> *) (m2 :: * -> *) where
+  -- | Lifts the first monad into the second.
+  genMorph :: db -> m1 a -> m2 a
+  
+instance ( fl ~ (TransformPath (PathFromList (ShortestPath (ToMorphRepo DB) x y)))
+         , CorrectPath x y fl
+         , GeneratableMorph DB fl
+         , Morph' fl x y
+         ) => GenMorph DB x y where
+  genMorph db = repr (generateMorph db :: fl)
+  
+class Morph' fl x y where
+  repr :: fl -> x a -> y a
+  
+instance Morph' r y z => Morph' (ConnectMorph x y :+: r) x z where
+  repr (ConnectMorph m :+: r) = repr r . m
+ 
+instance (Morph' r m x, Monad m) => Morph' (IdentityMorph m :+: r) Identity x where
+  repr (IdentityMorph :+: r) = (repr r :: forall a . m a -> x a) . return . runIdentity
+  
+instance Morph' (MUMorph m :+: r) m Proxy where
+  repr (MUMorph :+: _) = const Proxy
+ 
+instance Morph' NoMorph x x where
+  repr fl = id
+  
+infixr 6 :+:
+data a :+: r = a :+: r 
+
+data NoMorph = NoMorph
+  
+type family ToMorphRepo db where
+  ToMorphRepo (cm :+: r) = TranslateConn cm ': ToMorphRepo r
+  ToMorphRepo NoMorph = '[]
+   
+type DB = ConnectMorph_2m Maybe MaybeT
+           :+: ConnectMorph_mt MaybeT 
+           :+: ConnectMorph Maybe [] 
+           :+: ConnectMorph_2m [] ListT
+           :+: ConnectMorph (MaybeT IO) (ListT IO)
+           :+: NoMorph
+ 
+db :: DB 
+db = ConnectMorph_2m (MaybeT . return) 
+       :+: ConnectMorph_mt (MaybeT . liftM Just) 
+       :+: ConnectMorph (maybeToList) 
+       :+: ConnectMorph_2m (ListT . return) 
+       :+: ConnectMorph (ListT . liftM maybeToList . runMaybeT) 
+       :+: NoMorph
+  
+-- | This class provides a way to construct the value-level transformations
+-- from the type-level path and a rulebase.
+class GeneratableMorph db ch where
+  generateMorph :: db -> ch
+    
+instance GeneratableMorph db NoMorph where
+  generateMorph _ = NoMorph
+  
+instance GeneratableMorph db r 
+      => GeneratableMorph db ((IdentityMorph m) :+: r) where
+  generateMorph db = IdentityMorph :+: generateMorph db
+  
+instance GeneratableMorph db r 
+      => GeneratableMorph db (MUMorph m :+: r) where
+  generateMorph db = MUMorph :+: generateMorph db
+  
+instance (HasMorph db (ConnectMorph a b), GeneratableMorph db r) 
+      => GeneratableMorph db (ConnectMorph a b :+: r) where
+  generateMorph db = getMorph db :+: generateMorph db
+  
+-- | This class extracts a given morph from the set of rules
+class HasMorph r m where 
+  getMorph :: r -> m
+instance {-# OVERLAPPING #-} Monad k => HasMorph (ConnectMorph_2m a b :+: r) (ConnectMorph a (b k)) where
+  getMorph (ConnectMorph_2m f :+: r) = ConnectMorph f
+instance {-# OVERLAPPING #-} Monad k => HasMorph (ConnectMorph_mt t :+: r) (ConnectMorph k (t k)) where
+  getMorph (ConnectMorph_mt f :+: r) = ConnectMorph f
+instance {-# OVERLAPS #-} HasMorph r m => HasMorph (c :+: r) m where
+  getMorph (c :+: r) = getMorph r
+instance {-# OVERLAPPABLE #-} HasMorph (m :+: r) m where
+  getMorph (c :+: r) = c
+
+-- | Checks if the path is found to provide usable error messages
+class CorrectPath from to path
+
+instance CorrectPath from to (a :+: b)
+instance CorrectPath from to NoMorph
+
+data ConnectMorph m1 m2 = ConnectMorph { fromConnectMorph :: forall a . m1 a -> m2 a }
+data ConnectMorph_2m m1 m2 = ConnectMorph_2m { fromConnectMorph_2m :: forall a k . Monad k => m1 a -> m2 k a }
+data ConnectMorph_mt mt = ConnectMorph_mt { fromConnectMorph_mt :: forall a k . Monad k => k a -> mt k a }
+data IdentityMorph (m :: * -> *) = IdentityMorph
+data MUMorph m = MUMorph
+
+-- | Transforms a path element from the generic format to the specific one
+type family TranslateConn m where
+  TranslateConn (ConnectMorph m1 m2) = Connect m1 m2
+  TranslateConn (ConnectMorph_2m m1 m2) = Connect_2m m1 m2
+  TranslateConn (ConnectMorph_mt mt) = Connect_mt mt
+  
+-- | Transforms the path from the generic format to the specific one
+type family TransformPath m where
+  TransformPath (Connect m1 m2 :+: r) = ConnectMorph m1 m2 :+: TransformPath r
+  TransformPath (Connect_id m :+: r) = IdentityMorph m :+: TransformPath r
+  TransformPath (Connect_MU m :+: r) = MUMorph m :+: TransformPath r
+  TransformPath NoMorph = NoMorph
+  TransformPath NoPathFound = NoPathFound
+  
+type family PathFromList ls where
+  PathFromList '[] = NoMorph
+  PathFromList '[ NoPathFound ] = NoPathFound
+  PathFromList (c ': ls) = c :+: PathFromList ls
+
+
+ examples/InstanceControl/Control/Instances/ShortestPath.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, MultiParamTypeClasses, FlexibleInstances, PolyKinds, UndecidableInstances, AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables, FlexibleContexts #-}
+
+module Control.Instances.ShortestPath where
+
+import Control.Monad.Identity
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.List
+import Control.Monad.State
+import Data.Maybe
+import Data.Proxy
+import GHC.TypeLits
+import Control.Instances.TypeLevelPrelude
+
+-- * Generic datatypes to store connections
+  
+data Connect m1 m2
+data Connect_2m m1 m2
+data Connect_mt mt
+data Connect_id m
+data Connect_MU m
+
+-- | Marks that there is no legal path between the two types according
+-- to the rulebase.
+data NoPathFound
+  
+type family ShortestPath (e :: [*]) (s :: * -> *) (t :: * -> *) :: [*] where
+  ShortestPath e t t = '[]
+  ShortestPath e Identity t = '[ Connect_id t ]
+  ShortestPath e s Proxy = '[ Connect_MU s ]
+  ShortestPath e s t = ShortestPath' e s (InitCurrent e t)
+  
+type family ShortestPath' (e :: [*]) (s :: * -> *) (c :: [[*]]) :: [*] where
+  ShortestPath' e s '[] = '[ NoPathFound ]
+  ShortestPath' e s c = FromMaybe (ShortestPath' e s (ApplyEdges e c c))
+                                  (GetFinished s c) 
+                                  
+                                      
+type family GetFinished s c where
+  GetFinished s ((Connect s b ': p) ': lls) 
+    = Just (Connect s b ': p)
+  GetFinished s (p ': lls) = GetFinished s lls
+  GetFinished s '[] = Nothing
+
+type family InitCurrent (e :: [*]) (t :: * -> *) :: [[*]] where
+  InitCurrent '[] t = '[]
+  InitCurrent (e ': es) t = IfJust (ApplyEdge e t)
+                                   ('[ MonomorphEnd e t ] ': InitCurrent es t) 
+                                   (InitCurrent es t)
+  
+type family ApplyEdges (e :: [*]) (co :: [[*]]) (c :: [[*]]) :: [[*]] where
+  ApplyEdges (e ': es) co ((Connect s b ': p) ': cs) 
+    = AppendJust (IfThenJust (IsJust (ApplyEdge e s)) 
+                                (MonomorphEnd e s ': Connect s b ': p)) 
+                 (ApplyEdges (e ': es) co cs)
+  ApplyEdges (e ': es) co '[] = ApplyEdges es co co
+  ApplyEdges '[] co cr = '[]  
+  
+type family ApplyEdge e t :: Maybe (* -> *) where
+  ApplyEdge (Connect ms mr) mr = Just ms
+  ApplyEdge (Connect_2m ms mt) (mt m) = Just ms
+  ApplyEdge (Connect_mt mt) (mt m) = Just m
+  ApplyEdge e t = Nothing
+
+type family MonomorphEnd c v :: * where
+  MonomorphEnd (Connect_2m m m') v = Connect m v
+  MonomorphEnd (Connect_mt t) (t m) = Connect m (t m)
+  MonomorphEnd c v = c
+
+
+ examples/InstanceControl/Control/Instances/Test.hs view
@@ -0,0 +1,23 @@+module Control.Instances.Test where
+
+import Control.Instances.Morph
+
+import Control.Monad.Identity
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.List
+import Control.Monad.State
+
+test1 :: Identity a -> IO a
+test1 = morph
+
+test2 :: Maybe a -> [a]
+test2 = morph
+
+test3 :: Maybe a -> ListT IO a
+test3 = morph
+
+test4 :: Maybe a -> MaybeT IO a
+test4 = morph
+
+test5 :: Monad m => Maybe a -> ListT (StateT s m) a
+test5 = morph
+ examples/InstanceControl/Control/Instances/TypeLevelPrelude.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, MultiParamTypeClasses, FlexibleInstances, PolyKinds, UndecidableInstances, AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables, FlexibleContexts #-}
+
+module Control.Instances.TypeLevelPrelude where
+
+import GHC.TypeLits
+
+type family Const a b where
+  Const a b = a
+  
+type family Seq a b where
+  Seq a b = b
+  
+type family LazyIfThenElse p a b where
+  LazyIfThenElse True a b = a
+  LazyIfThenElse False a b = b
+  
+type family Iterate a where
+  Iterate a = a ': Iterate a
+
+type family l1 :++: l2 where
+  '[] :++: l2       = l2
+  (e ': r1) :++: l2 = e ': (r1 :++: l2)
+  
+type family Elem e ls where
+  Elem e '[] = False
+  Elem e (e ': ls) = True
+  Elem e (x ': ls) = Elem e ls
+  
+type family IfThenElse (b :: Bool) (th :: x) (el :: x) :: x where
+  IfThenElse True  th el = th
+  IfThenElse False th el = el
+         
+type family Length ls :: Nat where
+  Length '[] = 0
+  Length (e ': ls) = 1 + Length ls
+           
+type family Head (ls :: [k]) :: k where
+  Head (e ': ls) = e   
+  
+type family HeadMaybe (ls :: [k]) :: Maybe k where
+  HeadMaybe (e ': ls) = Just e
+  HeadMaybe '[] = Nothing
+  
+type family FromMaybe d m where
+  FromMaybe d (Just x) = x
+  FromMaybe d Nothing = d
+  
+type family Same a b where
+  Same a a = True
+  Same a b = False
+  
+type family Null (ls :: [k]) :: Bool where
+  Null '[] = True
+  Null ls = False
+           
+type family MapAppend e lls where
+  MapAppend e (ls ': lls) = (e ': ls) ': MapAppend e lls
+  MapAppend e '[] = '[]
+  
+type family AppendJust m ls where
+  AppendJust (Just x) ls = x ': ls
+  AppendJust Nothing ls = ls
+  
+type family Revert ls where
+  Revert '[] = '[]
+  Revert (e ': ls) = Revert ls :++: '[ e ]
+  
+type family IfThenJust (p :: Bool) (v :: k) :: Maybe k where
+  IfThenJust True v = Just v
+  IfThenJust False v = Nothing  
+  
+type family IfJust (p :: Maybe k) (t :: kr) (e :: kr) :: kr where
+  IfJust (Just x) t e = t
+  IfJust Nothing t e = e
+  
+type family IsJust (p :: Maybe k) :: Bool where
+  IsJust (Just x) = True
+  IsJust Nothing = False    
+  
+type family FromJust (p :: Maybe k) :: k where
+  FromJust (Just x) = x
+  
+type family Cat (f2 :: k2 -> k3) (f1 :: k1 -> k2) (a :: k1) :: k3 where
+  Cat f2 f1 a = f2 (f1 a)
+  
+
+  
+
+ examples/Module/DeprecatedPragma.hs view
@@ -0,0 +1,1 @@+module Module.DeprecatedPragma {-# DEPRECATED "this module is deprecated" #-} where
+ examples/Module/Export.hs view
@@ -0,0 +1,2 @@+module Module.Export (maybe, Maybe(..), Either(Left)) where
+-- this module reexports Maybe from Prelude
+ examples/Module/GhcOptionsPragma.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+module Module.GhcOptionsPragma where
+ examples/Module/Import.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE PackageImports #-}
+module Module.Import where
+
+import Data.List
+import "base" Data.List
+import {-# SOURCE #-} Data.List
+import qualified Data.List
+import Data.List as List
+import Data.List(map,(++))
+import Data.Function hiding ((&))
+ examples/Module/NamespaceExport.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TypeOperators #-}
+module Module.NamespaceExport (type (++)) where
+
+data a ++ b = Ctor
+ examples/Module/Simple.hs view
@@ -0,0 +1,1 @@+module Module.Simple where
+ examples/Module/WarningPragma.hs view
@@ -0,0 +1,1 @@+module Module.WarningPragma {-# WARNING "this module is dangerous" #-} where
+ examples/Pattern/Backtick.hs view
@@ -0,0 +1,5 @@+module Pattern.Backtick where
+
+data Point = Point { x :: Prelude.Int, y :: Int }
+
+f (x `Point` y) = 0
+ examples/Pattern/Constructor.hs view
@@ -0,0 +1,3 @@+module Pattern.Constructor where
+
+Just x = Just 1
+ examples/Pattern/ImplicitParams.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE ImplicitParams #-}
+module Pattern.ImplicitParams where
+
+import Data.List (sortBy)
+
+sort :: (?cmp :: a -> a -> Ordering) => [a] -> [a]
+sort = sortBy ?cmp
+
+main = let ?cmp = compare in putStrLn (show (sort [3,1,2]))
+ examples/Pattern/Infix.hs view
@@ -0,0 +1,5 @@+module Pattern.Infix where
+
+--(a:b:c:d) = ["1","2","3","4"]
+
+Nothing:_ = undefined
+ examples/Pattern/NPlusK.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE NPlusKPatterns #-}
+module Pattern.NPlusK where
+
+factorial :: Integer -> Integer
+factorial 0 = 1
+factorial (n+1) = (*) (n+1) (factorial n)
+ examples/Pattern/Record.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
+module Pattern.Record where
+
+data Point = Point { x :: Int, y :: Int }
+
+f Point { x = 3, y = 1 } = 0
+f Point {} = 1
+
+g Point { x } = x
+
+h Point { x = 1, .. } = y
+ examples/Refactor/CommentHandling/BlockComments.hs view
@@ -0,0 +1,10 @@+module Refactor.CommentHandling.BlockComments where
+
+{-| 1 -}
+{- 2 -}
+import Control.Monad {- 3 -}
+{-^ 4 -}
+{-| 5 -}
+{- 6 -}
+import Control.Monad as Monad {- 7 -}
+{-^ 8 -}
+ examples/Refactor/CommentHandling/CommentTypes.hs view
@@ -0,0 +1,10 @@+module Refactor.CommentHandling.CommentTypes where
+
+-- | 1
+-- 2
+import Control.Monad -- 3
+-- ^ 4
+-- | 5
+-- 6
+import Control.Monad as Monad -- 7
+-- ^ 8
+ examples/Refactor/CommentHandling/Crosslinking.hs view
@@ -0,0 +1,6 @@+module Refactor.CommentHandling.Crosslinking where
+
+import Control.Monad
+-- | forward
+-- ^ back
+import Control.Monad as Monad
+ examples/Refactor/CommentHandling/FunctionArgs.hs view
@@ -0,0 +1,6 @@+module Refactor.CommentHandling.FunctionArgs where
+
+f :: Int -- something
+  -> {-| result -} Int
+  -> Int  -- ^ other thing
+f = undefined
+ examples/Refactor/DataToNewtype/Cases.hs view
@@ -0,0 +1,8 @@+module Refactor.DataToNewtype.Cases where
+
+data A = A Int
+
+newtype B = B Int
+data C = C
+data D = D Int Int
+data E
+ examples/Refactor/DataToNewtype/Cases_res.hs view
@@ -0,0 +1,8 @@+module Refactor.DataToNewtype.Cases where
+
+newtype A = A Int
+
+newtype B = B Int
+data C = C
+data D = D Int Int
+data E
+ examples/Refactor/DollarApp/AnotherOperator.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.AnotherOperator where
+
+import Refactor.DollarApp.Defs
+
+x = f (g $$ 3)
+ examples/Refactor/DollarApp/AnotherOperator_res.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.AnotherOperator where
+
+import Refactor.DollarApp.Defs
+
+x = f (g $$ 3)
+ examples/Refactor/DollarApp/Defs.hs view
@@ -0,0 +1,9 @@+module Refactor.DollarApp.Defs where
+
+f = id
+g = id
+
+($$) :: (a -> b) -> a -> a
+f $$ a = a
+
+infixl 0 $$
+ examples/Refactor/DollarApp/Final.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.DollarApp.Final where
+
+import Prelude ((+))
+
+import A
+
+x = f (g 1)
+x2 = f (f (g 2))
+
+x3 = f (g 3) + 3
+x4 = 3 + f (g 4)
+
+x5 = f (g $$ 1)
+x6 = f (1 + 1)
+
+ examples/Refactor/DollarApp/FirstMulti.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.FirstMulti where
+
+import Refactor.DollarApp.Defs
+
+x = f (f (g 2))
+ examples/Refactor/DollarApp/FirstMulti_res.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.FirstMulti where
+
+import Refactor.DollarApp.Defs
+
+x = f $ f $ g 2
+ examples/Refactor/DollarApp/FirstSingle.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.FirstSingle where
+
+import Refactor.DollarApp.Defs
+
+x = f (g 1)
+ examples/Refactor/DollarApp/FirstSingle_res.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.FirstSingle where
+
+import Refactor.DollarApp.Defs
+
+x = f $ g 1
+ examples/Refactor/DollarApp/ImportDollar.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.DollarApp.ImportDollar where
+
+import Refactor.DollarApp.Defs
+
+x = f (g x)
+ examples/Refactor/DollarApp/ImportDollar_res.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.DollarApp.ImportDollar where
+
+import Refactor.DollarApp.Defs
+import GHC.Base(($))
+
+x = f $ g x
+ examples/Refactor/DollarApp/InfixOperator.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.InfixOperator where
+
+import Refactor.DollarApp.Defs
+
+x = f (g 3) + 3
+ examples/Refactor/DollarApp/InfixOperator_res.hs view
@@ -0,0 +1,5 @@+module Refactor.DollarApp.InfixOperator where
+
+import Refactor.DollarApp.Defs
+
+x = (f $ g 3) + 3
+ examples/Refactor/ExtractBinding/AddToExisting.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.AddToExisting where
+
+x = a ++ []
+  where a = []
+ examples/Refactor/ExtractBinding/AddToExisting_res.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.AddToExisting where
+
+x = a ++ b
+  where a = []
+        b = []
+ examples/Refactor/ExtractBinding/ClassInstance.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.ClassInstance where
+
+data Better a = Better a
+
+instance Functor Better where
+  fmap f (Better a) = Better (f a)
+ examples/Refactor/ExtractBinding/ClassInstance_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.ClassInstance where
+
+data Better a = Better a
+
+instance Functor Better where
+  fmap f (Better a) = Better g
+    where g = f a
+ examples/Refactor/ExtractBinding/ExistingLocalDef.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.ExistingLocalDef where
+
+f = 1 + 2 + 3
+  where
+ examples/Refactor/ExtractBinding/ExistingLocalDef_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.ExistingLocalDef where
+
+f = a + 3
+  where a = 1 + 2
+ examples/Refactor/ExtractBinding/ExtractedFormatting.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.ExtractedFormatting where
+
+stms 
+  = id
+  . id
+ examples/Refactor/ExtractBinding/ExtractedFormatting_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.ExtractedFormatting where
+
+stms 
+  = extracted
+  where extracted = id
+                  . id
+ examples/Refactor/ExtractBinding/Indentation.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.Indentation where
+
+f a = case Just a of 
+  Nothing -> 0
+  Just x -> x
+ examples/Refactor/ExtractBinding/IndentationMultiLine.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.IndentationMultiLine where
+
+f a = case Just a of 
+  Nothing 
+    -> 0
+  Just x 
+    -> x
+ examples/Refactor/ExtractBinding/IndentationMultiLine_res.hs view
@@ -0,0 +1,8 @@+module Refactor.ExtractBinding.IndentationMultiLine where
+
+f a = case extracted of 
+    Nothing 
+      -> 0
+    Just x 
+      -> x
+  where extracted = Just a
+ examples/Refactor/ExtractBinding/IndentationOperator.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.IndentationOperator where
+
+f aaa bbb = id . id $
+  aaa
+    ++ bbb
+ examples/Refactor/ExtractBinding/IndentationOperator_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.IndentationOperator where
+
+f aaa bbb = extracted $
+    aaa
+      ++ bbb
+  where extracted = id . id
+ examples/Refactor/ExtractBinding/Indentation_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.Indentation where
+
+f a = case extracted of 
+    Nothing -> 0
+    Just x -> x
+  where extracted = Just a
+ examples/Refactor/ExtractBinding/ListComprehension.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.ListComprehension where
+
+filterPrime (p:xs) = 
+  p : filterPrime [ x | x <- xs
+                      , x `mod` p /= 0 ]
+ examples/Refactor/ExtractBinding/ListComprehension_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.ListComprehension where
+
+filterPrime (p:xs) = 
+    p : filterPrime [ x | x <- xs
+                        , notDivisible x ]
+  where notDivisible x = x `mod` p /= 0
+ examples/Refactor/ExtractBinding/LocalDefinition.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.LocalDefinition where
+
+stms = x
+  where x = "s"
+ examples/Refactor/ExtractBinding/LocalDefinition_res.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.LocalDefinition where
+
+stms = x
+  where x = y
+          where y = "s"
+ examples/Refactor/ExtractBinding/NameConflict.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.NameConflict where
+
+stms = map (\s -> s ++ bang) ["a", "b"]
+  where bang = "!"
+ examples/Refactor/ExtractBinding/Parentheses.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.Parentheses where
+
+distance p1 p2 = sqrt ((x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2)
+
+-- try to rename the type, the constructor or the fields
+data Point = Point { x :: Double, y :: Double }
+ examples/Refactor/ExtractBinding/Parentheses_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.Parentheses where
+
+distance p1 p2 = sqrt sqDistance
+  where sqDistance = (x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2
+
+-- try to rename the type, the constructor or the fields
+data Point = Point { x :: Double, y :: Double }
+ examples/Refactor/ExtractBinding/RecordWildcards.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE RecordWildCards #-}
+module Refactor.ExtractBinding.RecordWildcards where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = (\(Point {..}) -> x + y) (Point 1 2)
+ examples/Refactor/ExtractBinding/RecordWildcards_res.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE RecordWildCards #-}
+module Refactor.ExtractBinding.RecordWildcards where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = plus (Point 1 2)
+  where plus (Point {..}) = x + y
+ examples/Refactor/ExtractBinding/Records.hs view
@@ -0,0 +1,5 @@+module Refactor.ExtractBinding.Records where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = (\(Point {x = x, y = y}) -> x + y) (Point 1 2)
+ examples/Refactor/ExtractBinding/Records_res.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.Records where
+
+data Point = Point { x :: Double, y :: Double }
+
+d = plus (Point 1 2)
+  where plus (Point {x = x, y = y}) = x + y
+ examples/Refactor/ExtractBinding/Simple.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.Simple where
+
+stms = map (\s -> s ++ "!") ["a", "b"]
+ examples/Refactor/ExtractBinding/Simple_res.hs view
@@ -0,0 +1,4 @@+module Refactor.ExtractBinding.Simple where
+
+stms = map (\s -> exaggerate s) ["a", "b"]
+  where exaggerate s = s ++ "!"
+ examples/Refactor/ExtractBinding/TooSimple.hs view
@@ -0,0 +1,3 @@+module Refactor.ExtractBinding.TooSimple where
+
+stms = map (\s -> s ++ "!") ["a", "b"]
+ examples/Refactor/GenerateExports/Normal.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TypeFamilies #-}
+module Refactor.GenerateExports.Normal where
+
+function :: Int -> Int
+function a = a
+
+data TypeCtor = DataCtor { recordName :: Int }
+
+class TypeClass a where
+  classFunction :: a -> a
+
+type family TypeFamily a :: *
+
+data family DataFamily a :: *
+
+foreign import ccall "exp" c_exp :: Double -> Double 
+
+ examples/Refactor/GenerateExports/Normal_res.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TypeFamilies #-}
+module Refactor.GenerateExports.Normal (function, TypeCtor(..), TypeClass(..), TypeFamily, DataFamily, c_exp) where
+
+function :: Int -> Int
+function a = a
+
+data TypeCtor = DataCtor { recordName :: Int }
+
+class TypeClass a where
+  classFunction :: a -> a
+
+type family TypeFamily a :: *
+
+data family DataFamily a :: *
+
+foreign import ccall "exp" c_exp :: Double -> Double 
+
+ examples/Refactor/GenerateExports/Operators.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeOperators #-}
+module Refactor.GenerateExports.Operators where
+
+(|=>|) :: Int -> Int -> Int
+a |=>| b = a + b
+
+data a :+: b = a :+: b
+ examples/Refactor/GenerateExports/Operators_res.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeOperators #-}
+module Refactor.GenerateExports.Operators ((|=>|), (:+:)(..)) where
+
+(|=>|) :: Int -> Int -> Int
+a |=>| b = a + b
+
+data a :+: b = a :+: b
+ examples/Refactor/GenerateTypeSignature/BringToScope/A.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.BringToScope.A where
+
+data T = T
+data S = S
+ examples/Refactor/GenerateTypeSignature/BringToScope/AlreadyQualImport.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.BringToScope.AlreadyQualImport where
+
+import Refactor.GenerateTypeSignature.BringToScope.B
+import qualified Refactor.GenerateTypeSignature.BringToScope.A as AAA (S)
+
+g = f
+ examples/Refactor/GenerateTypeSignature/BringToScope/AlreadyQualImport_res.hs view
@@ -0,0 +1,8 @@+module Refactor.GenerateTypeSignature.BringToScope.AlreadyQualImport where
+
+import Refactor.GenerateTypeSignature.BringToScope.B
+import qualified Refactor.GenerateTypeSignature.BringToScope.A as AAA (S)
+import Refactor.GenerateTypeSignature.BringToScope.A(T)
+
+g :: T -> AAA.S
+g = f
+ examples/Refactor/GenerateTypeSignature/BringToScope/B.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.BringToScope.B where 
+
+import Refactor.GenerateTypeSignature.BringToScope.A
+
+f :: T -> S
+f = const S
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariable.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariable where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariableHasOtherDef.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariableHasOtherDef where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+
+someOtherFun :: (k,v) -> (k,v)
+someOtherFun = id
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariableHasOtherDef_res.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariableHasOtherDef where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 :: Ord k => (k, v) -> Map.Map k v -> Map.Map k v
+        f1 (k,v) m = Map.insertWith accf k v m
+
+someOtherFun :: (k,v) -> (k,v)
+someOtherFun = id
+ examples/Refactor/GenerateTypeSignature/CanCaptureVariable_res.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Refactor.GenerateTypeSignature.CanCaptureVariable where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 :: Ord k => (k, v) -> Map.Map k v -> Map.Map k v
+        f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/CannotCaptureVariable.hs view
@@ -0,0 +1,7 @@+module Refactor.GenerateTypeSignature.CannotCaptureVariable where
+
+import qualified Data.Map as Map
+
+insertMany :: (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/CannotCaptureVariableNoExt.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE RankNTypes #-}
+module Refactor.GenerateTypeSignature.CannotCaptureVariableNoExt where
+
+import qualified Data.Map as Map
+
+insertMany :: forall k v . (Ord k) => (v -> v -> v) -> [(k,v)] -> Map.Map k v -> Map.Map k v
+insertMany accf vs m = foldr f1 m vs
+  where f1 (k,v) m = Map.insertWith accf k v m
+ examples/Refactor/GenerateTypeSignature/Complex.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Complex where
+
+app f x = f (Just x)
+ examples/Refactor/GenerateTypeSignature/ComplexLhs.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.ComplexLhs where
+
+(x) = 3
+Just y = Just 4
+(a,b) = (1,2)
+[c,d,e] = [1,2,3]
+ examples/Refactor/GenerateTypeSignature/Complex_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Complex where
+
+app :: (Maybe a -> t) -> a -> t
+app f x = f (Just x)
+ examples/Refactor/GenerateTypeSignature/Function.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Function where
+
+identity x = x
+ examples/Refactor/GenerateTypeSignature/Function_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Function where
+
+identity :: t -> t
+identity x = x
+ examples/Refactor/GenerateTypeSignature/HigherOrder.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.HigherOrder where
+
+app f x = f x
+ examples/Refactor/GenerateTypeSignature/HigherOrder_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.HigherOrder where
+
+app :: (t -> t1) -> t -> t1
+app f x = f x
+ examples/Refactor/GenerateTypeSignature/Let.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Let where
+
+x = let unit = ()
+     in ()
+ examples/Refactor/GenerateTypeSignature/Let_res.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.Let where
+
+x = let unit :: ()
+        unit = ()
+     in ()
+ examples/Refactor/GenerateTypeSignature/Local.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Local where
+
+x = () where
+  unit = ()
+ examples/Refactor/GenerateTypeSignature/Local_res.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.Local where
+
+x = () where
+  unit :: ()
+  unit = ()
+ examples/Refactor/GenerateTypeSignature/Placement.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.Placement where
+
+otherThing = ()
+unit = ()
+anotherThing = ()
+ examples/Refactor/GenerateTypeSignature/Placement_res.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.Placement where
+
+otherThing = ()
+unit :: ()
+unit = ()
+anotherThing = ()
+ examples/Refactor/GenerateTypeSignature/Polymorph.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.Polymorph where
+
+three = 3
+
+four :: Int
+four = three + 1
+ examples/Refactor/GenerateTypeSignature/PolymorphSub.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.PolymorphSub where
+
+f :: Num a => a -> a
+f a = g a where
+  g a = a + 1
+ examples/Refactor/GenerateTypeSignature/PolymorphSubMulti.hs view
@@ -0,0 +1,5 @@+module Refactor.GenerateTypeSignature.PolymorphSubMulti where
+
+f :: (Num a, Ord a) => a -> a
+f a = g a where
+  g a = if a > 0 then a + 1 else a
+ examples/Refactor/GenerateTypeSignature/PolymorphSubMulti_res.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.PolymorphSubMulti where
+
+f :: (Num a, Ord a) => a -> a
+f a = g a where
+  g :: (Ord t, Num t) => t -> t
+  g a = if a > 0 then a + 1 else a
+ examples/Refactor/GenerateTypeSignature/PolymorphSub_res.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.PolymorphSub where
+
+f :: Num a => a -> a
+f a = g a where
+  g :: Num a => a -> a
+  g a = a + 1
+ examples/Refactor/GenerateTypeSignature/Polymorph_res.hs view
@@ -0,0 +1,7 @@+module Refactor.GenerateTypeSignature.Polymorph where
+
+three :: Int
+three = 3
+
+four :: Int
+four = three + 1
+ examples/Refactor/GenerateTypeSignature/Simple.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Simple where
+
+unit = ()
+ examples/Refactor/GenerateTypeSignature/Simple_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Simple where
+
+unit :: ()
+unit = ()
+ examples/Refactor/GenerateTypeSignature/Tuple.hs view
@@ -0,0 +1,3 @@+module Refactor.GenerateTypeSignature.Tuple where
+
+tuple x y = (x,y)
+ examples/Refactor/GenerateTypeSignature/Tuple_res.hs view
@@ -0,0 +1,4 @@+module Refactor.GenerateTypeSignature.Tuple where
+
+tuple :: t -> t1 -> (t, t1)
+tuple x y = (x,y)
+ examples/Refactor/GenerateTypeSignature/TypeDefinedInModule.hs view
@@ -0,0 +1,6 @@+module Refactor.GenerateTypeSignature.TypeDefinedInModule where
+
+distance p1 p2 = sqrt ((x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2)
+
+data Point = Point { x :: Double, y :: Double }
+
+ examples/Refactor/GenerateTypeSignature/TypeDefinedInModule_res.hs view
@@ -0,0 +1,7 @@+module Refactor.GenerateTypeSignature.TypeDefinedInModule where
+
+distance :: Point -> Point -> Double
+distance p1 p2 = sqrt ((x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2)
+
+data Point = Point { x :: Double, y :: Double }
+
+ examples/Refactor/IfToGuards/Simple.hs view
@@ -0,0 +1,3 @@+module Refactor.IfToGuards.Simple where
+
+max a b = if a > b then a else b
+ examples/Refactor/IfToGuards/Simple_res.hs view
@@ -0,0 +1,4 @@+module Refactor.IfToGuards.Simple where
+
+max a b | a > b = a
+        | otherwise = b
+ examples/Refactor/InlineBinding/AlreadyApplied.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.AlreadyApplied where
+
+b u v = a u v
+a x y = x ++ y
+ examples/Refactor/InlineBinding/AlreadyApplied_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.AlreadyApplied where
+
+b u v = (u ++ v)
+ examples/Refactor/InlineBinding/AppearsInAnother/A.hs view
@@ -0,0 +1,3 @@+module A where
+
+a = ()
+ examples/Refactor/InlineBinding/AppearsInAnother/B.hs view
@@ -0,0 +1,5 @@+module B where
+
+import A
+
+b = a
+ examples/Refactor/InlineBinding/AutoNaming.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.Simplest where
+
+b = a
+a x = x
+x1 = ()
+ examples/Refactor/InlineBinding/AutoNaming_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Simplest where
+
+b = (\x2 -> x2)
+x1 = ()
+ examples/Refactor/InlineBinding/FilterSignatures.hs view
@@ -0,0 +1,7 @@+module Refactor.InlineBinding.FilterSignatures where
+
+b u v = u <++> v
+(<++>), (<**>) :: String -> String -> String
+x <++> y = x ++ y
+x <**> y = y ++ x
+infixl 7 <++>, <**>
+ examples/Refactor/InlineBinding/FilterSignatures_res.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.FilterSignatures where
+
+b u v = (u ++ v)
+(<**>) :: String -> String -> String
+x <**> y = y ++ x
+infixl 7 <**>
+ examples/Refactor/InlineBinding/InExportList.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.InExportList (a) where
+
+b = a
+a = ()
+ examples/Refactor/InlineBinding/Local.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Local where
+
+b = a
+  where a = ()
+ examples/Refactor/InlineBinding/LocalNested.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.LocalNested where
+
+a = b
+  where b = c
+          where c = ()
+ examples/Refactor/InlineBinding/LocalNested_res.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.LocalNested where
+
+a = b
+  where b = ()
+          where
+ examples/Refactor/InlineBinding/Local_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Local where
+
+b = ()
+  where
+ examples/Refactor/InlineBinding/MultiApplied.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.MultiApplied where
+
+b u v = a u v
+a x "a" = x
+a "a" y = y
+a x y = x ++ y
+ examples/Refactor/InlineBinding/MultiApplied_res.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.MultiApplied where
+
+b u v = (case (u, v) of (x, "a") -> x
+                        ("a", y) -> y
+                        (x, y) -> x ++ y)
+ examples/Refactor/InlineBinding/MultiMatch.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.MultiMatch where
+
+b = a
+a x "a" = x
+a "a" y = y
+a x y = x ++ y
+ examples/Refactor/InlineBinding/MultiMatchGuarded.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.MultiMatchGuarded where
+
+b u v = a u v
+a x y | x == y
+      = x
+a x y = x ++ y
+ examples/Refactor/InlineBinding/MultiMatchGuarded_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.MultiMatchGuarded where
+
+b u v = (case (u, v) of (x, y) | x == y -> x
+                        (x, y) -> x ++ y)
+ examples/Refactor/InlineBinding/MultiMatch_res.hs view
@@ -0,0 +1,5 @@+module Refactor.InlineBinding.MultiMatch where
+
+b = (\x1 x2 -> case (x1, x2) of (x, "a") -> x
+                                ("a", y) -> y
+                                (x, y) -> x ++ y)
+ examples/Refactor/InlineBinding/Nested.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Nested where
+
+b = f (f ())
+f a = a
+ examples/Refactor/InlineBinding/Nested_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.Nested where
+
+b = (())
+ examples/Refactor/InlineBinding/NotOccurring.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.NotOccurring where
+
+a = ()
+ examples/Refactor/InlineBinding/Operator.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Operator where
+
+b u v = u <++> v
+x <++> y = x ++ y
+ examples/Refactor/InlineBinding/Operator_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.Operator where
+
+b u v = (u ++ v)
+ examples/Refactor/InlineBinding/PatternMatched.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.PatternMatched where
+
+b u v = a (Just u) v
+a (Just x) (Just y) = x ++ y
+ examples/Refactor/InlineBinding/PatternMatched_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.PatternMatched where
+
+b u v = ((\(Just y) -> u ++ y) v)
+ examples/Refactor/InlineBinding/Recursive.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Recursive where
+
+b = f ()
+f a = f a
+ examples/Refactor/InlineBinding/RemoveSignatures.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.RemoveSignatures where
+
+b u v = u <++> v
+(<++>) :: String -> String -> String
+x <++> y = x ++ y
+infixl 7 <++>
+ examples/Refactor/InlineBinding/RemoveSignatures_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.RemoveSignatures where
+
+b u v = (u ++ v)
+ examples/Refactor/InlineBinding/SimpleMultiMatch.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.SimpleMultiMatch where
+
+b = a
+a x y = x ++ y
+ examples/Refactor/InlineBinding/SimpleMultiMatch_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.SimpleMultiMatch where
+
+b = (\x y -> x ++ y)
+ examples/Refactor/InlineBinding/Simplest.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.Simplest where
+
+b = a
+a = ()
+ examples/Refactor/InlineBinding/Simplest_res.hs view
@@ -0,0 +1,3 @@+module Refactor.InlineBinding.Simplest where
+
+b = ()
+ examples/Refactor/InlineBinding/WithLocals.hs view
@@ -0,0 +1,6 @@+module Refactor.InlineBinding.WithLocals where
+
+b = a
+a = x y
+  where x = id
+        y = ()
+ examples/Refactor/InlineBinding/WithLocals_res.hs view
@@ -0,0 +1,4 @@+module Refactor.InlineBinding.WithLocals where
+
+b = (let x = id
+         y = () in x y)
+ examples/Refactor/OrganizeImports/Class.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Class where
+
+import Decl.TypeClass (C(f))
+import Decl.TypeInstance
+
+test = f A
+ examples/Refactor/OrganizeImports/Class_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.Class where
+
+import Decl.TypeClass (C(f))
+import Decl.TypeInstance
+
+test = f A
+ examples/Refactor/OrganizeImports/Ctor.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Ctor where
+
+import Data.Maybe (Maybe(Nothing, Just))
+
+test = Just 3
+ examples/Refactor/OrganizeImports/Ctor_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Ctor where
+
+import Data.Maybe (Maybe(Just))
+
+test = Just 3
+ examples/Refactor/OrganizeImports/Narrow.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Narrow where
+
+import Data.List (map, null)
+
+test = map (+1) [1..10]
+ examples/Refactor/OrganizeImports/Narrow_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Narrow where
+
+import Data.List (map)
+
+test = map (+1) [1..10]
+ examples/Refactor/OrganizeImports/Operator.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Operator where
+
+import Data.List ((\\), intersect)
+
+test = [1,2,3] \\ [1,2]
+ examples/Refactor/OrganizeImports/Operator_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Operator where
+
+import Data.List ((\\))
+
+test = [1,2,3] \\ [1,2]
+ examples/Refactor/OrganizeImports/Removed.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Removed where
+
+import Control.Monad
+import Control.Monad as Monad
+
+ examples/Refactor/OrganizeImports/Removed_res.hs view
@@ -0,0 +1,4 @@+module Refactor.OrganizeImports.Removed where
+
+import Control.Monad as Monad ()
+
+ examples/Refactor/OrganizeImports/Reorder.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Reorder where
+
+import Data.List ()
+import Control.Monad ()
+
+ examples/Refactor/OrganizeImports/Reorder_res.hs view
@@ -0,0 +1,5 @@+module Refactor.OrganizeImports.Reorder where
+
+import Control.Monad ()
+import Data.List ()
+
+ examples/Refactor/OrganizeImports/SameName.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.SameName where
+
+import Data.List (map, null)
+
+test = map (+1) [1..null]
+  where null = 10
+ examples/Refactor/OrganizeImports/SameName_res.hs view
@@ -0,0 +1,6 @@+module Refactor.OrganizeImports.SameName where
+
+import Data.List (map)
+
+test = map (+1) [1..null]
+  where null = 10
+ examples/Refactor/OrganizeImports/Unused.hs view
@@ -0,0 +1,4 @@+module Refactor.OrganizeImports.Unused where
+
+import Control.Monad
+
+ examples/Refactor/OrganizeImports/Unused_res.hs view
@@ -0,0 +1,4 @@+module Refactor.OrganizeImports.Unused where
+
+import Control.Monad ()
+
+ examples/Refactor/RenameDefinition/AmbiguousFields.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DuplicateRecordFields #-}
+module Refactor.RenameDefinition.AmbiguousFields where
+
+data A = A { x, y :: Int }
+data B = B { x, y :: Int }
+
+f :: A -> Int
+f = x
+
+g :: B -> Int
+g = x
+ examples/Refactor/RenameDefinition/AmbiguousFields_res.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DuplicateRecordFields #-}
+module Refactor.RenameDefinition.AmbiguousFields where
+
+data A = A { xx, y :: Int }
+data B = B { x, y :: Int }
+
+f :: A -> Int
+f = xx
+
+g :: B -> Int
+g = x
+ examples/Refactor/RenameDefinition/Arg.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.Arg where
+
+f :: Int -> Int
+f x = x
+ examples/Refactor/RenameDefinition/Arg_res.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.Arg where
+
+f :: Int -> Int
+f y = y
+ examples/Refactor/RenameDefinition/BacktickName.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.BacktickName where
+
+f :: Int -> Int -> Int
+f = (+)
+
+x = 3 `f` 4
+ examples/Refactor/RenameDefinition/BacktickName_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.BacktickName where
+
+g :: Int -> Int -> Int
+g = (+)
+
+x = 3 `g` 4
+ examples/Refactor/RenameDefinition/ClassMember.hs view
@@ -0,0 +1,7 @@+module Refactor.RenameDefinition.ClassMember where
+
+class C t where
+  f :: t -> t
+
+instance C Int where
+  f i = i
+ examples/Refactor/RenameDefinition/ClassMember_res.hs view
@@ -0,0 +1,7 @@+module Refactor.RenameDefinition.ClassMember where
+
+class C t where
+  q :: t -> t
+
+instance C Int where
+  q i = i
+ examples/Refactor/RenameDefinition/ClassTypeVar.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.ClassTypeVar where
+
+class C t where
+  f :: t -> t
+ examples/Refactor/RenameDefinition/ClassTypeVar_res.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.ClassTypeVar where
+
+class C f where
+  f :: f -> f
+ examples/Refactor/RenameDefinition/Constructor.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Constructor where
+
+data Point = Point Double Double
+
+distance :: Point -> Point -> Double
+distance (Point x1 y1) (Point x2 y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+ examples/Refactor/RenameDefinition/Constructor_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Constructor where
+
+data Point = Point2D Double Double
+
+distance :: Point -> Point -> Double
+distance (Point2D x1 y1) (Point2D x2 y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+ examples/Refactor/RenameDefinition/DefineSplices.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.DefineSplices where
+
+import Language.Haskell.TH
+
+nameOf :: Name -> Q [Dec]
+nameOf n = return []
+ examples/Refactor/RenameDefinition/FormattingAware.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.FormattingAware where
+
+a = [ "a"
+    , "b"
+    , "c"
+    ]
+ examples/Refactor/RenameDefinition/FormattingAware_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.FormattingAware where
+
+aa = [ "a"
+     , "b"
+     , "c"
+     ]
+ examples/Refactor/RenameDefinition/FunTypeVar.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.FunTypeVar where
+
+f :: a -> a
+f x = x
+ examples/Refactor/RenameDefinition/FunTypeVarLocal.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.FunTypeVarLocal where
+
+g = f () 
+  where
+    f :: a -> a
+    f x = x
+ examples/Refactor/RenameDefinition/FunTypeVarLocal_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.FunTypeVarLocal where
+
+g = f () 
+  where
+    f :: b -> b
+    f x = x
+ examples/Refactor/RenameDefinition/FunTypeVar_res.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.FunTypeVar where
+
+f :: x -> x
+f x = x
+ examples/Refactor/RenameDefinition/Function.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Function where
+
+f :: Int -> Int
+f x = x
+
+g = f
+ examples/Refactor/RenameDefinition/Function_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Function where
+
+q :: Int -> Int
+q x = x
+
+g = q
+ examples/Refactor/RenameDefinition/IllegalQualRename.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}
+module Refactor.RenameDefinition.IllegalQualRename where
+
+type family IfThenElse (b :: Bool) (th :: x) (el :: x) :: x where
+  IfThenElse True  th el = th
+  IfThenElse False th el = el
+ examples/Refactor/RenameDefinition/ImplicitParams.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ImplicitParams #-}
+
+module Refactor.RenameDefinition.ImplicitParams where
+
+import Data.List
+
+sort' :: (?cmp :: a -> a -> Ordering) => [a] -> [a]
+sort' = sortBy ?cmp
+
+main = let ?cmp = compare in putStrLn (show (sort' [3,1,2]))
+ examples/Refactor/RenameDefinition/ImplicitParams_res.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ImplicitParams #-}
+
+module Refactor.RenameDefinition.ImplicitParams where
+
+import Data.List
+
+sort' :: (?compare :: a -> a -> Ordering) => [a] -> [a]
+sort' = sortBy ?compare
+
+main = let ?cmp = compare in putStrLn (show (sort' [3,1,2]))
+ examples/Refactor/RenameDefinition/LayoutAware.hs view
@@ -0,0 +1,5 @@+module Refactor.RenameDefinition.LayoutAware where
+
+a = do putStrLn "a"
+       putStrLn "b"
+       putStrLn "c"
+ examples/Refactor/RenameDefinition/LayoutAware_res.hs view
@@ -0,0 +1,5 @@+module Refactor.RenameDefinition.LayoutAware where
+
+main = do putStrLn "a"
+          putStrLn "b"
+          putStrLn "c"
+ examples/Refactor/RenameDefinition/LibraryFunction.hs view
@@ -0,0 +1,4 @@+module Refactor.RenameDefinition.LibraryFunction where
+
+f :: Int -> Int
+f = id
+ examples/Refactor/RenameDefinition/LocalFunction.hs view
@@ -0,0 +1,10 @@+module Refactor.RenameDefinition.LocalFunction where
+
+f :: Int -> Int
+f = x
+  where x :: Int -> Int
+        x = id
+
+
+g :: Int -> Int
+g = id
+ examples/Refactor/RenameDefinition/LocalFunction_res.hs view
@@ -0,0 +1,10 @@+module Refactor.RenameDefinition.LocalFunction where
+
+f :: Int -> Int
+f = g
+  where g :: Int -> Int
+        g = id
+
+
+g :: Int -> Int
+g = id
+ examples/Refactor/RenameDefinition/MultiModule/A.hs view
@@ -0,0 +1,5 @@+module A where
+
+import B
+
+a = b
+ examples/Refactor/RenameDefinition/MultiModule/B.hs view
@@ -0,0 +1,3 @@+module B where
+
+b = ()
+ examples/Refactor/RenameDefinition/MultiModule_res/A.hs view
@@ -0,0 +1,5 @@+module A where
+
+import B
+
+a = bb
+ examples/Refactor/RenameDefinition/MultiModule_res/B.hs view
@@ -0,0 +1,3 @@+module B where
+
+bb = ()
+ examples/Refactor/RenameDefinition/NameClash.hs view
@@ -0,0 +1,11 @@+module Refactor.RenameDefinition.NameClash where
+
+f :: Int -> Int
+f = g
+  where g :: Int -> Int
+        g = id
+
+        h :: Int -> Int
+        h = id
+
+test = f
+ examples/Refactor/RenameDefinition/NoPrelude.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.RenameDefinition.NoPrelude where
+
+f = ()
+test = f
+ examples/Refactor/RenameDefinition/NoPrelude_res.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE NoImplicitPrelude #-}
+module Refactor.RenameDefinition.NoPrelude where
+
+map = ()
+test = map
+ examples/Refactor/RenameDefinition/ParenName.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.ParenName where
+
+(<>) :: Int -> Int -> Int
+a <> b = a + b
+
+x = (<>) 3 4
+ examples/Refactor/RenameDefinition/ParenName_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.ParenName where
+
+(<->) :: Int -> Int -> Int
+a <-> b = a + b
+
+x = (<->) 3 4
+ examples/Refactor/RenameDefinition/QualName.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.QualName where
+
+f :: Int -> Int
+f x = x
+
+g = Refactor.RenameDefinition.QualName.f
+ examples/Refactor/RenameDefinition/QualName_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.QualName where
+
+q :: Int -> Int
+q x = x
+
+g = Refactor.RenameDefinition.QualName.q
+ examples/Refactor/RenameDefinition/RecordField.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.RecordField where
+
+data Point = Point { x :: Double, y :: Double }
+
+distance :: Point -> Point -> Double
+distance p1 p2 = sqrt ((x p1 - x p2) ^ 2 + (y p1 - y p2) ^ 2)
+ examples/Refactor/RenameDefinition/RecordField_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.RecordField where
+
+data Point = Point { xCoord :: Double, y :: Double }
+
+distance :: Point -> Point -> Double
+distance p1 p2 = sqrt ((xCoord p1 - xCoord p2) ^ 2 + (y p1 - y p2) ^ 2)
+ examples/Refactor/RenameDefinition/RecordPatternSynonyms.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE PatternSynonyms #-}
+module Refactor.RenameDefinition.RecordPatternSynonyms where
+
+pattern Point {x, y} = (x, y)
+
+r = (0, 0) { x = 1 }
+ examples/Refactor/RenameDefinition/RecordPatternSynonyms_res.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE PatternSynonyms #-}
+module Refactor.RenameDefinition.RecordPatternSynonyms where
+
+pattern Point {xx, y} = (xx, y)
+
+r = (0, 0) { xx = 1 }
+ examples/Refactor/RenameDefinition/RecordWildcards.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE RecordWildCards #-}
+module Refactor.RenameDefinition.RecordWildcards where
+
+data Point = Point { x :: Int, y :: Int }
+
+p1 = let x = 3; y = 4 in Point { x = 1, .. }
+
+p2 = let Point { .. } = Point 1 2 in y
+ examples/Refactor/RenameDefinition/RecordWildcards_res.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE RecordWildCards #-}
+module Refactor.RenameDefinition.RecordWildcards where
+
+data Point = Point { x :: Int, yy :: Int }
+
+p1 = let x = 3; yy = 4 in Point { x = 1, .. }
+
+p2 = let Point { .. } = Point 1 2 in yy
+ examples/Refactor/RenameDefinition/RenameModule/A.hs view
@@ -0,0 +1,5 @@+module A where
+
+import B
+
+a = b
+ examples/Refactor/RenameDefinition/RenameModule/B.hs view
@@ -0,0 +1,3 @@+module B where
+
+b = ()
+ examples/Refactor/RenameDefinition/RenameModule_res/A.hs view
@@ -0,0 +1,5 @@+module A where
+
+import C
+
+a = b
+ examples/Refactor/RenameDefinition/RenameModule_res/C.hs view
@@ -0,0 +1,3 @@+module C where
+
+b = ()
+ examples/Refactor/RenameDefinition/RoleAnnotation.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE RoleAnnotations #-}
+module Refactor.RenameDefinition.RoleAnnotation where
+
+type role A nominal nominal
+data A a b = A a b
+ examples/Refactor/RenameDefinition/RoleAnnotation_res.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE RoleAnnotations #-}
+module Refactor.RenameDefinition.RoleAnnotation where
+
+type role AA nominal nominal
+data AA a b = A a b
+ examples/Refactor/RenameDefinition/SameCtorAndType.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.SameCtorAndType where
+
+data Point2D = P2D Double Double
+
+origo :: Point2D
+origo = P2D 0.0 0.0
+ examples/Refactor/RenameDefinition/SameCtorAndType_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.SameCtorAndType where
+
+data P2D = P2D Double Double
+
+origo :: P2D
+origo = P2D 0.0 0.0
+ examples/Refactor/RenameDefinition/SpliceDecls/Define.hs view
@@ -0,0 +1,9 @@+module Define where
+
+import Language.Haskell.TH
+
+defHello :: Q [Dec]
+defHello = def "hello"
+
+def :: String -> Q [Dec]
+def name = return [ ValD (VarP (mkName name)) (NormalB $ LitE $ IntegerL 3) [] ]
+ examples/Refactor/RenameDefinition/SpliceDecls/Use.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+module Use where
+
+import Define
+
+defHello
+
+$(let x = return [] in x)
+ examples/Refactor/RenameDefinition/SpliceDecls_res/Define.hs view
@@ -0,0 +1,9 @@+module Define where
+
+import Language.Haskell.TH
+
+hello :: Q [Dec]
+hello = def "hello"
+
+def :: String -> Q [Dec]
+def name = return [ ValD (VarP (mkName name)) (NormalB $ LitE $ IntegerL 3) [] ]
+ examples/Refactor/RenameDefinition/SpliceDecls_res/Use.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+module Use where
+
+import Define
+
+hello
+
+$(let x = return [] in x)
+ examples/Refactor/RenameDefinition/SpliceExpr/Define.hs view
@@ -0,0 +1,6 @@+module Define where
+
+import Language.Haskell.TH
+
+expr :: Q Exp
+expr = return $ LitE $ IntegerL 3
+ examples/Refactor/RenameDefinition/SpliceExpr/Use.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}
+module Use where
+
+import Define
+
+e :: Int
+e = $(expr)
+ examples/Refactor/RenameDefinition/SpliceExpr_res/Define.hs view
@@ -0,0 +1,6 @@+module Define where
+
+import Language.Haskell.TH
+
+exprSplice :: Q Exp
+exprSplice = return $ LitE $ IntegerL 3
+ examples/Refactor/RenameDefinition/SpliceExpr_res/Use.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}
+module Use where
+
+import Define
+
+e :: Int
+e = $(exprSplice)
+ examples/Refactor/RenameDefinition/SpliceType/Define.hs view
@@ -0,0 +1,6 @@+module Define where
+
+import Language.Haskell.TH
+
+typ :: Q Type
+typ = return $ TupleT 0
+ examples/Refactor/RenameDefinition/SpliceType/Use.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}
+module Use where
+
+import Define
+
+a :: $typ
+a = ()
+ examples/Refactor/RenameDefinition/SpliceType_res/Define.hs view
@@ -0,0 +1,6 @@+module Define where
+
+import Language.Haskell.TH
+
+spliceTyp :: Q Type
+spliceTyp = return $ TupleT 0
+ examples/Refactor/RenameDefinition/SpliceType_res/Use.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}
+module Use where
+
+import Define
+
+a :: $spliceTyp
+a = ()
+ examples/Refactor/RenameDefinition/Type.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Type where
+
+data Point = Point Double Double
+
+distance :: Point -> Point -> Double
+distance (Point x1 y1) (Point x2 y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+ examples/Refactor/RenameDefinition/TypeBracket.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.RenameDefinition.TypeBracket where
+
+import TH.Splice.Define
+
+data A = A
+
+nameOf ''A
+ examples/Refactor/RenameDefinition/TypeBracket_res.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.RenameDefinition.TypeBracket where
+
+import TH.Splice.Define
+
+data B = A
+
+nameOf ''B
+ examples/Refactor/RenameDefinition/TypeOperators.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators #-}
+module Refactor.RenameDefinition.TypeOperators where
+
+type family l1 :++: l2 where
+  '[] :++: l2       = l2
+  (e ': r1) :++: l2 = e ': (r1 :++: l2)
+
+ examples/Refactor/RenameDefinition/TypeOperators_res.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators #-}
+module Refactor.RenameDefinition.TypeOperators where
+
+type family x1 :++: l2 where
+  '[] :++: l2       = l2
+  (e ': r1) :++: l2 = e ': (r1 :++: l2)
+
+ examples/Refactor/RenameDefinition/Type_res.hs view
@@ -0,0 +1,6 @@+module Refactor.RenameDefinition.Type where
+
+data Point2D = Point Double Double
+
+distance :: Point2D -> Point2D -> Double
+distance (Point x1 y1) (Point x2 y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+ examples/Refactor/RenameDefinition/UnusedDef.hs view
@@ -0,0 +1,3 @@+module Refactor.RenameDefinition.UnusedDef where
+
+f = ()
+ examples/Refactor/RenameDefinition/UnusedDef_res.hs view
@@ -0,0 +1,3 @@+module Refactor.RenameDefinition.UnusedDef where
+
+map = ()
+ examples/Refactor/RenameDefinition/ValBracket.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.RenameDefinition.ValBracket where
+
+import TH.Splice.Define
+
+data A = A
+
+$(nameOf 'A)
+ examples/Refactor/RenameDefinition/ValBracket_res.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}
+module Refactor.RenameDefinition.ValBracket where
+
+import TH.Splice.Define
+
+data A = B
+
+$(nameOf 'B)
+ examples/Refactor/RenameDefinition/WrongName.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TypeOperators #-}
+module Refactor.RenameDefinition.WrongName where
+
+f :: Int -> Int
+f x = x
+
+data X = X
+
+data a .+. b = a :+: b
+
+(+++) = (+)
+ examples/TH/Brackets.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell #-}
+module TH.Brackets where
+
+import Language.Haskell.TH
+
+decls :: Q [Dec]
+decls = [d| w = 3 |]
+
+exp :: Q Exp
+exp = [| 3 |]
+
+exp' :: Q Exp
+exp' = [e| 3 |]
+
+pat :: Q Pat
+pat = [p| x |]
+
+typ :: Q Type
+typ = [t| Int |]
+ examples/TH/QuasiQuote/Define.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -fno-warn-missing-fields #-}
+module TH.QuasiQuote.Define where
+
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH
+
+expr :: QuasiQuoter
+expr = QuasiQuoter { quoteExp = const (return $ VarE $ mkName "hello") }
+ examples/TH/QuasiQuote/Use.hs view
@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -fno-warn-missing-fields #-}
+{-# LANGUAGE QuasiQuotes #-}
+module TH.QuasiQuote.Use where
+
+import TH.QuasiQuote.Define
+
+hello :: Int
+hello = 3
+
+main :: IO ()
+main = print [expr| 1 + 2 + 4|]
+ examples/TH/Splice/Define.hs view
@@ -0,0 +1,24 @@+module TH.Splice.Define where
+
+import Language.Haskell.TH
+
+def :: String -> Q [Dec]
+def name = return [ ValD (VarP (mkName name)) (NormalB $ LitE $ IntegerL 3) [] ]
+
+defHello :: Q [Dec]
+defHello = def "hello"
+
+defHello2 :: Q [Dec]
+defHello2 = def "hello2"
+
+defHello3 :: Q [Dec]
+defHello3 = def "hello3"
+
+expr :: Q Exp
+expr = return $ LitE $ IntegerL 3
+
+typ :: Q Type
+typ = return $ TupleT 0
+
+nameOf :: Name -> Q [Dec]
+nameOf n = return []
+ examples/TH/Splice/Names.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TemplateHaskell #-}
+module TH.Splice.Names where
+
+import TH.Splice.Define
+
+data A = A
+
+$(nameOf ''A)
+nameOf ''A
+
+$(nameOf 'A)
+nameOf 'A
+ examples/TH/Splice/Use.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell #-}
+module TH.Splice.Use where
+
+import TH.Splice.Define
+
+$(return [])
+
+$(let x = return [] in x)
+
+$(def "x")
+
+$(defHello)
+
+$defHello2
+
+defHello3
+
+a :: $typ
+a = ()
+
+e :: Int
+e = $expr
+ examples/Type/Bang.hs view
@@ -0,0 +1,4 @@+module Type.Bang where
+
+data X = X !Int
+
+ examples/Type/Builtin.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE MagicHash #-}
+module Type.Builtin where
+
+import GHC.Prim 
+import GHC.Base
+
+x1 :: IO ()
+x1 = undefined
+
+x2 :: IO Int
+x2 = return 2
+
+x3 :: Int
+x3 = I# x3'
+  where x3' :: Int#
+        x3' = 3#
+
+x4 :: (Int, Bool)
+x4 = (3,True)
+
+ examples/Type/Ctx.hs view
@@ -0,0 +1,10 @@+module Type.Ctx where
+
+sh :: Show a => a -> String
+sh = show
+
+sh' :: (Show a) => a -> String
+sh' = show
+
+sh'' :: (Show a, Eq a) => a -> String
+sh'' = show
+ examples/Type/ExplicitTypeApplication.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeApplications #-}
+module Type.ExplicitTypeApplication where
+
+quad :: a -> b -> c -> d -> (a, b, c, d)
+quad w x y z = (w, x, y, z)
+
+foo = quad @Bool @_ @Int False 'c' 17 "Hello!"
+ examples/Type/Forall.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE ScopedTypeVariables #-}
+module Type.Forall where
+
+id :: forall a . a -> a
+id x = x
+
+id' :: a -> a
+id' x = x
+
+id'' :: forall a . Monoid a => a -> a
+id'' x = x
+ examples/Type/Primitives.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MagicHash #-}
+module Type.Primitives where
+import GHC.Prim
+
+data MyInt = MyInt Int#
+
+my3 = MyInt 3#
+
+myPlus :: MyInt -> MyInt -> MyInt
+myPlus (MyInt i) (MyInt j) = MyInt (i +# j)
+ examples/Type/TypeOperators.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeOperators #-}
+module Type.TypeOperators where
+
+infixr 6 :+:
+data a :+: r = a :+: r 
+
+type X = Int :+: Char :+: String
+ examples/Type/Unpack.hs view
@@ -0,0 +1,4 @@+module Type.Unpack where
+
+data X = X {-# UNPACK #-} !Int {-# NOUNPACK #-} !Int 
+
+ examples/Type/Wildcard.hs view
@@ -0,0 +1,7 @@+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+module Type.Wildcard where
+
+not' :: Bool -> _
+not' x = not x
+-- Inferred: Bool -> Bool
haskell-tools-refactor.cabal view
@@ -1,5 +1,5 @@ name:                haskell-tools-refactor
-version:             0.4.1.0
+version:             0.4.1.1
 synopsis:            Refactoring Tool for Haskell
 description:         Contains a set of refactorings based on the Haskell-Tools framework to easily transform a Haskell program. For the descriptions of the implemented refactorings, see the homepage.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -10,6 +10,41 @@ category:            Language
 build-type:          Simple
 cabal-version:       >=1.10
+
+extra-source-files: examples/CppHs/Language/Preprocessor/*.hs
+                  , examples/CppHs/Language/Preprocessor/Cpphs/*.hs
+                  , examples/CppHs/Language/Preprocessor/Cpphs/*.hs
+                  , examples/Decl/*.hs
+                  , examples/Expr/*.hs
+                  , examples/InstanceControl/Control/Instances/*.hs
+                  , examples/Module/*.hs
+                  , examples/Pattern/*.hs
+                  , examples/Refactor/CommentHandling/*.hs
+                  , examples/Refactor/DataToNewtype/*.hs
+                  , examples/Refactor/DollarApp/*.hs
+                  , examples/Refactor/ExtractBinding/*.hs
+                  , examples/Refactor/GenerateExports/*.hs
+                  , examples/Refactor/GenerateTypeSignature/*.hs
+                  , examples/Refactor/GenerateTypeSignature/BringToScope/*.hs
+                  , examples/Refactor/IfToGuards/*.hs
+                  , examples/Refactor/InlineBinding/*.hs
+                  , examples/Refactor/InlineBinding/AppearsInAnother/*.hs
+                  , examples/Refactor/OrganizeImports/*.hs
+                  , examples/Refactor/RenameDefinition/*.hs
+                  , examples/Refactor/RenameDefinition/MultiModule/*.hs
+                  , examples/Refactor/RenameDefinition/MultiModule_res/*.hs
+                  , examples/Refactor/RenameDefinition/RenameModule/*.hs
+                  , examples/Refactor/RenameDefinition/RenameModule_res/*.hs
+                  , examples/Refactor/RenameDefinition/SpliceDecls/*.hs
+                  , examples/Refactor/RenameDefinition/SpliceDecls_res/*.hs
+                  , examples/Refactor/RenameDefinition/SpliceExpr/*.hs
+                  , examples/Refactor/RenameDefinition/SpliceExpr_res/*.hs
+                  , examples/Refactor/RenameDefinition/SpliceType/*.hs
+                  , examples/Refactor/RenameDefinition/SpliceType_res/*.hs
+                  , examples/TH/*.hs
+                  , examples/TH/QuasiQuote/*.hs
+                  , examples/TH/Splice/*.hs
+                  , examples/Type/*.hs
 
 library
   ghc-options:         -O2
test/Main.hs view
@@ -83,7 +83,7 @@                           ++ map (\(mod,_,_) -> mod) wrongExtractBindingTests
                           ++ map (\(mod,_) -> mod) inlineBindingTests
 
-rootDir = ".." </> ".." </> "examples"
+rootDir = "examples"
         
 languageTests =
   [ "Decl.AmbiguousFields"