diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,2 +1,11 @@ +0.1.2: + * Actual order independent choosing. + * Added test cases. + * Refactored code. + +0.1.1: + * Include needed modules. + * Smarter, order-independent auto-choosing. + 0.1: * Initial release diff --git a/exe/Halberd.hs b/exe/Halberd.hs new file mode 100644 --- /dev/null +++ b/exe/Halberd.hs @@ -0,0 +1,50 @@ +module Main where + +import Control.Applicative +import Control.Monad hiding (forM_) +import Data.Foldable (forM_) +import Data.List +import Data.Proxy +import Distribution.HaskellSuite +import Distribution.Simple.Compiler +import Language.Haskell.Exts.Annotated +import Language.Haskell.Names.Interfaces +import System.Environment +import System.Exit + +import Halberd.ChosenImports +import Halberd.Suggestions +import Halberd.UI + +main :: IO () +main = + do args <- getArgs + case args of + [] -> do + putStrLn "Usage: halberd " + exitFailure + (file:_) -> do + (ParseOk module_) <- parseFile file + pkgs <- concat <$> mapM (getInstalledPackages (Proxy :: Proxy NamesDB)) + [UserPackageDB, GlobalPackageDB, SpecificPackageDB "/Users/erik/doc/haskell-suite/.cabal-sandbox/x86_64-osx-haskell-names-0.1-packages.conf.d"] + allSuggestions <- evalModuleT (suggestedImports module_) pkgs suffix readInterface + + let (suggestions, noSuggestions) = partition (not . null . snd) allSuggestions + + chosenImports <- askUserChoices suggestions + + when (not . null $ noSuggestions) $ do + putStrLn "------------- Could not find import for -------------" + forM_ noSuggestions $ \(q, _) -> do + putStrLn $ " - " ++ prettyPrint q + putStrLn "" + + when (not . isEmpty $ chosenImports) $ do + putStrLn "-------- Insert these imports into your file --------" + putStrLn "" + putStrLn $ unlines (showChosenImports chosenImports) + where + suffix = "names" + +askUserChoices :: [Suggestion] -> IO ChosenImports +askUserChoices = resolveAllSuggestions askUserChoice diff --git a/exe/Halberd/UI.hs b/exe/Halberd/UI.hs new file mode 100644 --- /dev/null +++ b/exe/Halberd/UI.hs @@ -0,0 +1,38 @@ +module Halberd.UI where + +import Control.Applicative +import Control.Monad.State hiding (forM_) +import Data.Foldable (forM_) +import qualified Distribution.Text as Cabal +import Language.Haskell.Exts.Annotated +import Language.Haskell.Names +import Safe +import System.IO + +import Halberd.Types + +askUserChoice :: MonadIO m => QName (Scoped SrcSpan) -> [CanonicalSymbol] -> m CanonicalSymbol +askUserChoice qname suggestions = liftIO $ + do putStrLn $ prettyPrint qname ++ ":" + forM_ (zip [1 :: Integer ..] suggestions) $ \(i, (_, modName, _)) -> putStrLn $ show i ++ ") " ++ Cabal.display modName + putStrLn "" + getChoice suggestions + +getChoice :: [a] -> IO a +getChoice xs = withoutOutput go + where + go = + do c <- getChar + let mi = readMay [c] + case (subtract 1) <$> mi >>= atMay xs of + Nothing -> go + Just x -> return x + withoutOutput action = + do buffering <- hGetBuffering stdin + echo <- hGetEcho stdout + hSetBuffering stdin NoBuffering + hSetEcho stdout False + result <- action + hSetBuffering stdin buffering + hSetEcho stdout echo + return result diff --git a/halberd.cabal b/halberd.cabal --- a/halberd.cabal +++ b/halberd.cabal @@ -1,5 +1,5 @@ name: halberd -version: 0.1.1 +version: 0.1.2 license: BSD3 license-file: LICENSE author: Erik Hesselink, Simon Meier, Tom Lokhorst, Roman Cheplyaka @@ -19,24 +19,59 @@ homepage: http://github.com/haskell-suite/halberd/ extra-source-files: CHANGELOG, README.md -executable halberd +library build-depends: base >= 4.5 && < 4.7 , containers >= 0.4 && < 0.6 , haskell-packages == 0.2.* , haskell-names == 0.2.* , haskell-src-exts == 1.14.* , Cabal >= 1.17 && < 1.19 - , filepath == 1.3.* , mtl >= 2.0 && < 2.2 - , tagged >= 0.4 && < 0.8 , safe == 0.3.* , syb >= 0.3 && < 0.5 hs-source-dirs: src - main-is: Halberd.hs ghc-options: -Wall - other-modules: Halberd.ChosenImports + exposed-modules: Halberd.ChosenImports , Halberd.CollectNames + , Halberd.LookupTable + , Halberd.Suggestions + , Halberd.Types + other-modules: Data.Tuple.Utils , Language.Haskell.Exts.Utils + +executable halberd + build-depends: base >= 4.5 && < 4.7 + , Cabal >= 1.17 && < 1.19 + , halberd == 0.1.1 + , haskell-names == 0.2.* + , haskell-packages == 0.2.* + , haskell-src-exts == 1.14.* + , mtl >= 2.0 && < 2.2 + , safe == 0.3.* + , tagged >= 0.4 && < 0.8 + hs-source-dirs: exe + main-is: Halberd.hs + ghc-options: -Wall + other-modules: Halberd.UI + +Test-suite halberd-tests + build-depends: base >= 4.5 && < 4.7 + , Cabal >= 1.17 && < 1.19 + , containers >= 0.4 && < 0.6 + , halberd == 0.1.1 + , HUnit == 1.2.* + , test-framework == 0.8.* + , test-framework-hunit == 0.3.* + , haskell-names == 0.2.* + , haskell-packages == 0.2.* + , haskell-src-exts == 1.14.* + , tagged >= 0.4 && < 0.8 + , split == 0.2.* + , mtl >= 2.0 && < 2.2 + hs-source-dirs: tests + main-is: Runner.hs + type: exitcode-stdio-1.0 + ghc-options: -Wall Source-Repository head Type: git diff --git a/src/Data/Tuple/Utils.hs b/src/Data/Tuple/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Data/Tuple/Utils.hs @@ -0,0 +1,7 @@ +module Data.Tuple.Utils where + +snd3 :: (a, b, c) -> b +snd3 (_, y, _) = y + +trd3 :: (a, b, c) -> c +trd3 (_, _, z) = z diff --git a/src/Halberd.hs b/src/Halberd.hs deleted file mode 100644 --- a/src/Halberd.hs +++ /dev/null @@ -1,208 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE DoAndIfThenElse #-} - -import Control.Applicative -import Control.Arrow -import Control.Monad hiding (forM_) -import Control.Monad.State hiding (forM_) -import Data.Foldable (forM_) -import Data.Function -import Data.List -import Data.Maybe -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Monoid -import Data.Ord -import Data.Proxy -import Data.Set (Set) -import qualified Data.Set as Set -import Distribution.HaskellSuite -import qualified Distribution.InstalledPackageInfo as Cabal -import qualified Distribution.ModuleName as Cabal -import qualified Distribution.Package as Cabal -import Distribution.Simple.Compiler -import qualified Distribution.Text as Cabal -import Language.Haskell.Exts.Annotated -import Language.Haskell.Names -import Language.Haskell.Names.Imports () -import Language.Haskell.Names.Interfaces -import Safe -import System.Environment -import System.Exit -import System.IO - -import Halberd.ChosenImports -import Halberd.CollectNames (collectUnboundNames) -import Language.Haskell.Exts.Utils - -main :: IO () -main = - do args <- getArgs - case args of - [] -> do - putStrLn "Usage: halberd " - exitFailure - (file:_) -> do - (ParseOk module_) <- parseFile file - pkgs <- concat <$> - mapM - (getInstalledPackages (Proxy :: Proxy NamesDB)) - [UserPackageDB, GlobalPackageDB, SpecificPackageDB "/Users/erik/doc/haskell-suite/.cabal-sandbox/x86_64-osx-haskell-names-0.1-packages.conf.d"] - allSuggestions <- evalModuleT (suggestedImports module_) pkgs suffix readInterface - - let (suggestions, noSuggestions) = partition (not . null . snd) allSuggestions - - chosenImports <- askUserChoices suggestions - - when (not . null $ noSuggestions) $ do - putStrLn "------------- Could not find import for -------------" - forM_ noSuggestions $ \(q, _) -> do - putStrLn $ " - " ++ prettyPrint q - putStrLn "" - - when (not . isEmpty $ chosenImports) $ do - putStrLn "-------- Insert these imports into your file --------" - putStrLn "" - putStrLn $ unlines (showChosenImports chosenImports) - where - suffix = "names" - -type Suggestion = (QName (Scoped SrcSpan), [CanonicalSymbol]) - -suggestedImports :: Module SrcSpanInfo -> ModuleT Symbols IO [Suggestion] -suggestedImports module_ = - do (unboundTypes, unboundValues) <- uniques <$> findUnbound module_ - (valueTable, typeTable) <- mkLookupTables - let valueSuggestions = map (id &&& lookupDefinitions valueTable) unboundValues - typeSuggestions = map (id &&& lookupDefinitions typeTable ) unboundTypes - return $ valueSuggestions ++ typeSuggestions - where - uniques = unique *** unique - unique = nubBy ((==) `on` void) - -askUserChoices :: [Suggestion] -> IO ChosenImports -askUserChoices suggestions = execStateT (go suggestions) mempty - where - go sugs = do - remaining <- resolveSuggestions sugs - case remaining of - [] -> return [] - ((qname, modules):ss) -> do - choice <- askUserChoice qname modules - modify $ insertChoice qname (snd3 choice) - go ss - -resolveSuggestions :: [Suggestion] -> StateT ChosenImports IO [Suggestion] -resolveSuggestions suggestions = fmap catMaybes . forM suggestions $ \suggestion@(qname, modules) -> - do chosenModules <- get - if alreadyChosen qname modules chosenModules - then - return Nothing - else do - case hasSingleOption qname modules chosenModules of - Nothing -> return $ Just suggestion - Just choice -> do - modify $ insertChoice qname (snd3 choice) - return Nothing - where - alreadyChosen qname modules chosenModules = fromMaybe False $ - do q <- getQualification qname - module_ <- lookupQualified q chosenModules - return $ module_ `elem` map snd3 modules - hasSingleOption _ [module_] _ = Just module_ - hasSingleOption UnQual{} modules chosenModules | singleOrigName modules = - headMay $ filter ((`Map.member` unqualifieds chosenModules) . snd3) modules - hasSingleOption _ _ _ = Nothing - singleOrigName = allEqual . map trd3 - allEqual [] = True - allEqual (x:xs) = all (== x) xs - -askUserChoice :: MonadIO m => QName (Scoped SrcSpan) -> [CanonicalSymbol] -> m CanonicalSymbol -askUserChoice qname suggestions = liftIO $ - do putStrLn $ prettyPrint qname ++ ":" - forM_ (zip [1 :: Integer ..] suggestions) $ \(i, (_, modName, _)) -> putStrLn $ show i ++ ") " ++ Cabal.display modName - putStrLn "" - getChoice suggestions - -getChoice :: [a] -> IO a -getChoice xs = withoutOutput go - where - go = - do c <- getChar - let mi = readMay [c] - case (subtract 1) <$> mi >>= atMay xs of - Nothing -> go - Just x -> return x - withoutOutput action = - do buffering <- hGetBuffering stdin - echo <- hGetEcho stdout - hSetBuffering stdin NoBuffering - hSetEcho stdout False - result <- action - hSetBuffering stdin buffering - hSetEcho stdout echo - return result - -type CanonicalSymbol = (PackageRef, Cabal.ModuleName, OrigName) - -data PackageRef = PackageRef - { installedPackageId :: Cabal.InstalledPackageId - , sourcePackageId :: Cabal.PackageId - } deriving (Eq, Ord, Show) - -toPackageRef :: Cabal.InstalledPackageInfo_ m -> PackageRef -toPackageRef pkgInfo = - PackageRef { installedPackageId = Cabal.installedPackageId pkgInfo - , sourcePackageId = Cabal.sourcePackageId pkgInfo - } - -findUnbound :: Module SrcSpanInfo -> ModuleT Symbols IO ([QName (Scoped SrcSpan)], [QName (Scoped SrcSpan)]) -findUnbound module_ = collectUnboundNames <$> annotateModule Haskell98 [] (fmap srcInfoSpan module_) - -type LookupTable = Map String [CanonicalSymbol] - -mkLookupTables :: ModuleT Symbols IO (LookupTable, LookupTable) -mkLookupTables = - do pkgs <- getPackages - (valueDefs, typeDefs) <- - fmap mconcat $ forM pkgs $ \pkg -> - fmap mconcat $ forM (Cabal.exposedModules pkg) $ \exposedModule -> do - (Symbols values types) <- readModuleInfo (Cabal.libraryDirs pkg) exposedModule - let mkDefs qname = Set.map ((toPackageRef pkg, exposedModule,) . origName) qname - return (mkDefs values, mkDefs types) - let valueTable = toLookupTable (gUnqual . trd3) valueDefs - typeTable = toLookupTable (gUnqual . trd3) typeDefs - return (valueTable, typeTable) - where - gUnqual (OrigName _ (GName _ n)) = n - - -lookupDefinitions :: Map String [CanonicalSymbol] -> QName (Scoped SrcSpan) -> [CanonicalSymbol] -lookupDefinitions symbolTable qname = fromMaybe [] $ - do n <- unQName qname - Map.lookup n symbolTable - where - unQName (Qual _ _ n) = Just (strName n) - unQName (UnQual _ n) = Just (strName n) - unQName (Special _ _ ) = Nothing - - strName (Ident _ str) = str - strName (Symbol _ str) = str - - -toLookupTable :: Ord k => (a -> k) -> Set a -> Map k [a] -toLookupTable key = Map.fromList - . map (fst . head &&& map snd) - . groupBy ((==) `on` fst) - . sortBy (comparing fst) - . map (key &&& id) - . Set.toList - -snd3 :: (a, b, c) -> b -snd3 (_, y, _) = y - -trd3 :: (a, b, c) -> c -trd3 (_, _, z) = z diff --git a/src/Halberd/ChosenImports.hs b/src/Halberd/ChosenImports.hs --- a/src/Halberd/ChosenImports.hs +++ b/src/Halberd/ChosenImports.hs @@ -12,7 +12,7 @@ data ChosenImports = ChosenImports { qualifieds :: Map (ModuleName ()) Cabal.ModuleName , unqualifieds :: Map Cabal.ModuleName [Name ()] - } + } deriving (Show, Eq) instance Monoid ChosenImports where mempty = ChosenImports diff --git a/src/Halberd/LookupTable.hs b/src/Halberd/LookupTable.hs new file mode 100644 --- /dev/null +++ b/src/Halberd/LookupTable.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE TupleSections #-} +module Halberd.LookupTable where + +import Control.Arrow +import Control.Monad hiding (forM_) +import Data.Function +import Data.List +import Data.Maybe +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Monoid +import Data.Ord +import Data.Set (Set) +import qualified Data.Set as Set +import Distribution.HaskellSuite +import qualified Distribution.InstalledPackageInfo as Cabal +import Language.Haskell.Exts.Annotated +import Language.Haskell.Names + +import Data.Tuple.Utils +import Halberd.Types + +type LookupTable = Map String [CanonicalSymbol] + +mkLookupTables :: ModuleT Symbols IO (LookupTable, LookupTable) +mkLookupTables = + do pkgs <- getPackages + (valueDefs, typeDefs) <- + fmap mconcat $ forM pkgs $ \pkg -> + fmap mconcat $ forM (Cabal.exposedModules pkg) $ \exposedModule -> do + (Symbols values types) <- readModuleInfo (Cabal.libraryDirs pkg) exposedModule + let mkDefs qname = Set.map ((toPackageRef pkg, exposedModule,) . origName) qname + return (mkDefs values, mkDefs types) + let valueTable = toLookupTable (gUnqual . trd3) valueDefs + typeTable = toLookupTable (gUnqual . trd3) typeDefs + return (valueTable, typeTable) + where + gUnqual (OrigName _ (GName _ n)) = n + + +lookupDefinitions :: LookupTable -> QName (Scoped SrcSpan) -> [CanonicalSymbol] +lookupDefinitions symbolTable qname = fromMaybe [] $ + do n <- unQName qname + Map.lookup n symbolTable + where + unQName (Qual _ _ n) = Just (strName n) + unQName (UnQual _ n) = Just (strName n) + unQName (Special _ _ ) = Nothing + + strName (Ident _ str) = str + strName (Symbol _ str) = str + + +toLookupTable :: Ord k => (a -> k) -> Set a -> Map k [a] +toLookupTable key = Map.fromList + . map (fst . head &&& map snd) + . groupBy ((==) `on` fst) + . sortBy (comparing fst) + . map (key &&& id) + . Set.toList diff --git a/src/Halberd/Suggestions.hs b/src/Halberd/Suggestions.hs new file mode 100644 --- /dev/null +++ b/src/Halberd/Suggestions.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE FlexibleContexts #-} +module Halberd.Suggestions where + +import Control.Applicative +import Control.Arrow +import Control.Monad hiding (forM_) +import Control.Monad.State hiding (forM_) +import Data.Function +import Data.List +import Data.Maybe +import qualified Data.Map as Map +import Data.Monoid +import Distribution.HaskellSuite +import Language.Haskell.Exts.Annotated +import Language.Haskell.Names +import Safe + +import Data.Tuple.Utils +import Halberd.ChosenImports +import Halberd.CollectNames +import Halberd.LookupTable +import Halberd.Types +import Language.Haskell.Exts.Utils + +type Suggestion = (QName (Scoped SrcSpan), [CanonicalSymbol]) + +suggestedImports :: Module SrcSpanInfo -> ModuleT Symbols IO [Suggestion] +suggestedImports module_ = + do (unboundTypes, unboundValues) <- uniques <$> findUnbound module_ + (valueTable, typeTable) <- mkLookupTables + let valueSuggestions = map (id &&& lookupDefinitions valueTable) unboundValues + typeSuggestions = map (id &&& lookupDefinitions typeTable ) unboundTypes + return $ valueSuggestions ++ typeSuggestions + where + uniques = unique *** unique + unique = nubBy ((==) `on` void) + +type ChooseExternal m = QName (Scoped SrcSpan) -> [CanonicalSymbol] -> m CanonicalSymbol + +resolveAllSuggestions :: (Functor m, Monad m) => ChooseExternal m -> [Suggestion] -> m ChosenImports +resolveAllSuggestions chooseExternal suggestions = execStateT (go suggestions) mempty + where + go sugs = do + remaining <- resolveSuggestions sugs + case remaining of + [] -> return [] + ((qname, modules):ss) -> do + choice <- lift $ chooseExternal qname modules + modify $ insertChoice qname (snd3 choice) + go ss + +resolveSuggestions :: (Functor m, MonadState ChosenImports m) => [Suggestion] -> m [Suggestion] +resolveSuggestions suggestions = + do newSuggestions <- resolveSuggestionsOnePass suggestions + if suggestions == newSuggestions + then return newSuggestions + else resolveSuggestions newSuggestions + +resolveSuggestionsOnePass :: (Functor m, MonadState ChosenImports m) => [Suggestion] -> m [Suggestion] +resolveSuggestionsOnePass suggestions = fmap catMaybes . forM suggestions $ \suggestion@(qname, modules) -> + do chosenModules <- get + if alreadyChosen qname modules chosenModules + then + return Nothing + else do + case hasSingleOption qname modules chosenModules of + Nothing -> return $ Just suggestion + Just choice -> do + modify $ insertChoice qname (snd3 choice) + return Nothing + where + alreadyChosen qname modules chosenModules = fromMaybe False $ + do q <- getQualification qname + module_ <- lookupQualified q chosenModules + return $ module_ `elem` map snd3 modules + hasSingleOption _ [module_] _ = Just module_ + hasSingleOption UnQual{} modules chosenModules | singleOrigName modules = + headMay $ filter ((`Map.member` unqualifieds chosenModules) . snd3) modules + hasSingleOption _ _ _ = Nothing + singleOrigName = allEqual . map trd3 + allEqual [] = True + allEqual (x:xs) = all (== x) xs + +findUnbound :: Module SrcSpanInfo -> ModuleT Symbols IO ([QName (Scoped SrcSpan)], [QName (Scoped SrcSpan)]) +findUnbound module_ = collectUnboundNames <$> annotateModule Haskell98 [] (fmap srcInfoSpan module_) diff --git a/src/Halberd/Types.hs b/src/Halberd/Types.hs new file mode 100644 --- /dev/null +++ b/src/Halberd/Types.hs @@ -0,0 +1,19 @@ +module Halberd.Types where + +import qualified Distribution.InstalledPackageInfo as Cabal +import qualified Distribution.ModuleName as Cabal +import qualified Distribution.Package as Cabal +import Language.Haskell.Names + +type CanonicalSymbol = (PackageRef, Cabal.ModuleName, OrigName) + +data PackageRef = PackageRef + { installedPackageId :: Cabal.InstalledPackageId + , sourcePackageId :: Cabal.PackageId + } deriving (Eq, Ord, Show) + +toPackageRef :: Cabal.InstalledPackageInfo_ m -> PackageRef +toPackageRef pkgInfo = + PackageRef { installedPackageId = Cabal.installedPackageId pkgInfo + , sourcePackageId = Cabal.sourcePackageId pkgInfo + } diff --git a/tests/Runner.hs b/tests/Runner.hs new file mode 100644 --- /dev/null +++ b/tests/Runner.hs @@ -0,0 +1,87 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} +import Control.Applicative +import Control.Monad +import Control.Monad.State +import Data.Char +import Data.Monoid +import Data.List.Split +import Data.Proxy +import Data.String +import Distribution.HaskellSuite +import Distribution.Simple.Compiler +import Language.Haskell.Exts.Annotated hiding (fileName) +import Language.Haskell.Names.Interfaces +import Test.Framework (defaultMain) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (assertEqual, Assertion) +import qualified Data.Map as Map +import qualified Distribution.ModuleName as Cabal + +import Halberd.ChosenImports (ChosenImports (..)) +import Halberd.Suggestions + +main :: IO () +main = do + pkgs <- concat <$> mapM (getInstalledPackages (Proxy :: Proxy NamesDB)) [UserPackageDB, GlobalPackageDB] + defaultMain [ testCase "Collect unbound" (collectUnbound pkgs) + , testCase "Resolve single option" (resolveSingleOption pkgs) + , testCase "Resolve multiple options" (resolveMultiple pkgs) + , testCase "Resolve multiple options (different order)" (resolveMultipleDifferentOrder pkgs) + ] + +collectUnbound :: Packages -> Assertion +collectUnbound pkgs = do + (ParseOk module_) <- parseFile "tests/input/Unbound.hs" + (unboundTypes, unboundValues) <- evalModuleT (findUnbound module_) pkgs "names" readInterface + assertEqual "Unbound types" (void <$> unboundTypes) ["M.Map", "Int8"] + assertEqual "Unbound values" (void <$> unboundValues) ["forM", "M.fromList"] + +testResolution :: FilePath -> ChosenImports -> Packages -> Assertion +testResolution fileName expectedImports pkgs = do + (ParseOk module_) <- parseFile fileName + suggestions <- evalModuleT (suggestedImports module_) pkgs "names" readInterface + let (newSuggestions, imports) = runState (resolveSuggestions suggestions) mempty + assertEqual "resolved suggestions" [] newSuggestions + assertEqual "chosen imports" expectedImports imports + +resolveSingleOption :: Packages -> Assertion +resolveSingleOption = testResolution "tests/input/ResolveSingle.hs" + ChosenImports { qualifieds = Map.fromList [] + , unqualifieds = Map.fromList [("Control.Applicative", ["pure"])] + } + +resolveMultiple :: Packages -> Assertion +resolveMultiple = testResolution "tests/input/ResolveMultiple.hs" + ChosenImports { qualifieds = Map.fromList [] + , unqualifieds = Map.fromList [("Control.Applicative", ["<$>", "pure"])] + } + +resolveMultipleDifferentOrder :: Packages -> Assertion +resolveMultipleDifferentOrder = testResolution "tests/input/ResolveMultipleDifferentOrder.hs" + ChosenImports { qualifieds = Map.fromList [] + , unqualifieds = Map.fromList [("Control.Applicative", ["<$>", "pure"])] + } + +-- Some instances to make it easier to write down expected values in +-- assertions. + +instance IsString (QName ()) where + fromString str = + let parts = splitOn "." str + in case parts of + [nm] -> UnQual () (fromString nm) + [qual,nm] -> Qual () (fromString qual) (fromString nm) + _ -> error "Too many dots in IsString Name." + +instance IsString (ModuleName ()) where + fromString = ModuleName () + +instance IsString (Name ()) where + fromString str = + if (isAlpha (head str) || head str == '_') + then Ident () str + else Symbol () str + +instance IsString Cabal.ModuleName where + fromString = Cabal.fromString