{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE TupleSections #-}
module Language.Haskell.Tools.Refactor.Builtin.GenerateExports
(generateExports, generateExportsRefactoring) where
import Control.Reference ((^?), (.=), (&))
import Language.Haskell.Tools.Refactor
import qualified GHC (NamedThing(..), Name)
import Control.Applicative ((<|>))
import Data.Maybe (Maybe(..), catMaybes)
generateExportsRefactoring :: RefactoringChoice
generateExportsRefactoring = ModuleRefactoring "GenerateExports" (localRefactoring generateExports)
generateExports :: LocalRefactoring
generateExports mod = return (modHead & annJust & mhExports & annMaybe
.= Just (createExports (getTopLevels mod)) $ mod)
getTopLevels :: Module -> [(GHC.Name, Bool)]
getTopLevels mod = catMaybes $ map (\d -> fmap (,exportContainOthers d)
(foldl (<|>) Nothing $ map semanticsName $ d ^? elementName))
(filter (\case TypeSigDecl{} -> False; _ -> True)
$ mod ^? modDecl & annList)
where exportContainOthers :: Decl -> Bool
exportContainOthers (DataDecl {}) = True
exportContainOthers (ClassDecl {}) = True
exportContainOthers _ = False
createExports :: [(GHC.Name, Bool)] -> ExportSpecs
createExports elems = mkExportSpecs $ map (mkExportSpec . createExport) elems
where createExport (n, False) = mkIESpec (mkUnqualName' (GHC.getName n)) Nothing
createExport (n, True) = mkIESpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)