Skip to content
Snippets Groups Projects
Commit d99a617b authored by Ben Gamari's avatar Ben Gamari Committed by Marge Bot
Browse files

Move Data ModuleName instance to Language.Haskell.Syntax.Module.Name

Fixes #25968.
parent aba2a4a5
No related branches found
No related tags found
No related merge requests found
{-# OPTIONS_GHC -Wno-orphans #-} -- instance Data ModuleName
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
......@@ -117,13 +115,6 @@ data GenModule unit = Module
}
deriving (Eq,Ord,Data,Functor)
-- TODO: should be moved back into Language.Haskell.Syntax.Module.Name
instance Data ModuleName where
-- don't traverse?
toConstr _ = abstractConstr "ModuleName"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "ModuleName"
-- | A Module is a pair of a 'Unit' and a 'ModuleName'.
type Module = GenModule Unit
......
......@@ -3,6 +3,7 @@ module Language.Haskell.Syntax.Module.Name where
import Prelude
import Data.Char (isAlphaNum)
import Data.Data
import Control.DeepSeq
import qualified Text.ParserCombinators.ReadP as Parse
import System.FilePath
......@@ -12,6 +13,14 @@ import GHC.Data.FastString
-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
newtype ModuleName = ModuleName FastString deriving (Show, Eq)
instance Data ModuleName where
-- don't traverse?
toConstr x = constr
where
constr = mkConstr (dataTypeOf x) "{abstract:ModuleName}" [] Prefix
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "ModuleName"
instance Ord ModuleName where
nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment