Distribution/Types/ModuleRenaming.hs

    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}

    module Distribution.Types.ModuleRenaming (
        ModuleRenaming(..),
        defaultRenaming,
        isDefaultRenaming,
    ) where

    import Prelude ()
    import Distribution.Compat.Prelude hiding (empty)

    import qualified Distribution.Compat.ReadP as Parse
    import Distribution.Compat.ReadP   ((<++))
    import Distribution.ModuleName
    import Distribution.Text

    import Text.PrettyPrint

    -- | Renaming applied to the modules provided by a package.
    -- The boolean indicates whether or not to also include all of the
    -- original names of modules.  Thus, @ModuleRenaming False []@ is
    -- "don't expose any modules, and @ModuleRenaming True [("Data.Bool", "Bool")]@
    -- is, "expose all modules, but also expose @Data.Bool@ as @Bool@".
    -- If a renaming is omitted you get the 'DefaultRenaming'.
    --
    -- (NB: This is a list not a map so that we can preserve order.)
    --
    data ModuleRenaming
            -- | A module renaming/thinning; e.g., @(A as B, C as C)@
            -- brings @B@ and @C@ into scope.
            = ModuleRenaming [(ModuleName, ModuleName)]
            -- | The default renaming, bringing all exported modules
            -- into scope.
            | DefaultRenaming
            -- | Hiding renaming, e.g., @hiding (A, B)@, bringing all
            -- exported modules into scope except the hidden ones.
            | HidingRenaming [ModuleName]
        deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)

    -- | The default renaming, if something is specified in @build-depends@
    -- only.
    defaultRenaming :: ModuleRenaming
    defaultRenaming = DefaultRenaming

    -- | Tests if its the default renaming; we can use a more compact syntax
    -- in 'Distribution.Types.IncludeRenaming.IncludeRenaming' in this case.
    isDefaultRenaming :: ModuleRenaming -> Bool
    isDefaultRenaming DefaultRenaming = True
    isDefaultRenaming _ = False

    instance Binary ModuleRenaming where

    -- NB: parentheses are mandatory, because later we may extend this syntax
    -- to allow "hiding (A, B)" or other modifier words.
    instance Text ModuleRenaming where
      disp DefaultRenaming = empty
      disp (HidingRenaming hides)
            = text "hiding" <+> parens (hsep (punctuate comma (map disp hides)))
      disp (ModuleRenaming rns)
            = parens . hsep $ punctuate comma (map dispEntry rns)
        where dispEntry (orig, new)
                | orig == new = disp orig
                | otherwise = disp orig <+> text "as" <+> disp new

      parse = do fmap ModuleRenaming parseRns
                 <++ parseHidingRenaming
                 <++ return DefaultRenaming
        where parseRns = do
                 rns <- Parse.between (Parse.char '(') (Parse.char ')') parseList
                 Parse.skipSpaces
                 return rns
              parseHidingRenaming = do
                _ <- Parse.string "hiding"
                Parse.skipSpaces
                hides <- Parse.between (Parse.char '(') (Parse.char ')')
                            (Parse.sepBy parse (Parse.char ',' >> Parse.skipSpaces))
                return (HidingRenaming hides)
              parseList =
                Parse.sepBy parseEntry (Parse.char ',' >> Parse.skipSpaces)
              parseEntry :: Parse.ReadP r (ModuleName, ModuleName)
              parseEntry = do
                orig <- parse
                Parse.skipSpaces
                (do _ <- Parse.string "as"
                    Parse.skipSpaces
                    new <- parse
                    Parse.skipSpaces
                    return (orig, new)
                 <++
                    return (orig, orig))