Cleanup some redundant constraint warnings

This commit is contained in:
Daniel Gröber 2016-05-22 02:53:51 +02:00
parent cfadbc6cb8
commit 3bf84fb64a
6 changed files with 11 additions and 19 deletions

View File

@ -66,7 +66,6 @@ instance Binary a => GGBinary (K1 i a) where
#define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum (fromIntegral size)
instance ( GSum a, GSum b
, GGBinary a, GGBinary b
, SumSize a, SumSize b) => GGBinary (a :+: b) where
ggput | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64)
| otherwise = sizeError "encode" size
@ -96,7 +95,7 @@ class GSum f where
getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a)
putSum :: (Num w, Bits w, Binary w) => w -> w -> f a -> Put
instance (GSum a, GSum b, GGBinary a, GGBinary b) => GSum (a :+: b) where
instance (GSum a, GSum b) => GSum (a :+: b) where
getSum !code !size | code < sizeL = L1 <$> getSum code sizeL
| otherwise = R1 <$> getSum (code - sizeL) sizeR
where

View File

@ -11,11 +11,6 @@ showPage dflag style = showDocWith dflag PageMode . withStyle dflag style
showOneLine :: DynFlags -> PprStyle -> SDoc -> String
showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style
-- showForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
-- showForUser dflags unqual sdoc =
-- showDocWith dflags PageMode $
-- runSDoc sdoc $ initSDocContext dflags $ mkUserStyle unqual AllTheWay
getStyle :: GhcMonad m => m PprStyle
getStyle = do
unqual <- getPrintUnqual

View File

@ -63,23 +63,22 @@ loadMappedFile' from to isTemp = do
let to' = makeRelative (cradleRootDir crdl) to
addMMappedFile cfn (FileMapping to' isTemp)
mapFile :: (IOish m, GmState m, GhcMonad m, GmEnv m) =>
HscEnv -> Target -> m Target
mapFile :: (IOish m, GmState m) => HscEnv -> Target -> m Target
mapFile _ (Target tid@(TargetFile filePath _) taoc _) = do
mapping <- lookupMMappedFile filePath
mkMappedTarget (Just filePath) tid taoc mapping
return $ mkMappedTarget (Just filePath) tid taoc mapping
mapFile env (Target tid@(TargetModule moduleName) taoc _) = do
(fp, mapping) <- do
filePath <- fmap (fmap mpPath) (liftIO $ findModulePath env moduleName)
mmf <- runMaybeT $ MaybeT (return filePath) >>= MaybeT . lookupMMappedFile
return (filePath, mmf)
mkMappedTarget fp tid taoc mapping
return $ mkMappedTarget fp tid taoc mapping
mkMappedTarget :: (IOish m, GmState m, GmEnv m, GhcMonad m) =>
Maybe FilePath -> TargetId -> Bool -> Maybe FileMapping -> m Target
mkMappedTarget :: Maybe FilePath -> TargetId -> Bool -> Maybe FileMapping -> Target
mkMappedTarget _ _ taoc (Just to) =
return $ mkTarget (TargetFile (fmPath to) Nothing) taoc Nothing
mkMappedTarget _ tid taoc _ = return $ mkTarget tid taoc Nothing
mkTarget (TargetFile (fmPath to) Nothing) taoc Nothing
mkMappedTarget _ tid taoc _ =
mkTarget tid taoc Nothing
{-|
unloads previously mapped file \'file\', so that it's no longer mapped,

View File

@ -103,7 +103,7 @@ runGmOutT opts ma = do
(const $ liftIO $ flushStdoutGateway gmoChan)
action
runGmOutT' :: IOish m => GhcModOut -> GmOutT m a -> m a
runGmOutT' :: GhcModOut -> GmOutT m a -> m a
runGmOutT' gmo ma = flip runReaderT gmo $ unGmOutT ma
-- | Run a @GhcModT m@ computation.

View File

@ -290,8 +290,7 @@ findCandidates scns = foldl1 Set.intersection scns
pickComponent :: Set ChComponentName -> ChComponentName
pickComponent scn = Set.findMin scn
packageGhcOptions :: (Applicative m, IOish m, Gm m)
=> m [GHCOption]
packageGhcOptions :: (IOish m, Applicative m, Gm m) => m [GHCOption]
packageGhcOptions = do
crdl <- cradle
case cradleProject crdl of

View File

@ -271,7 +271,7 @@ instance Binary GmModuleGraph where
mpGraph = Map.map (Set.map intToMp) $ Map.mapKeys intToMp graph
return $ GmModuleGraph mpGraph
where
swapMap :: (Ord k, Ord v) => Map k v -> Map v k
swapMap :: Ord v => Map k v -> Map v k
swapMap = Map.fromList . map (\(x, y) -> (y, x)) . Map.toList
instance Monoid GmModuleGraph where