Cleanup some redundant constraint warnings
This commit is contained in:
parent
cfadbc6cb8
commit
3bf84fb64a
@ -66,7 +66,6 @@ instance Binary a => GGBinary (K1 i a) where
|
|||||||
#define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum (fromIntegral size)
|
#define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum (fromIntegral size)
|
||||||
|
|
||||||
instance ( GSum a, GSum b
|
instance ( GSum a, GSum b
|
||||||
, GGBinary a, GGBinary b
|
|
||||||
, SumSize a, SumSize b) => GGBinary (a :+: b) where
|
, SumSize a, SumSize b) => GGBinary (a :+: b) where
|
||||||
ggput | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64)
|
ggput | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64)
|
||||||
| otherwise = sizeError "encode" size
|
| otherwise = sizeError "encode" size
|
||||||
@ -96,7 +95,7 @@ class GSum f where
|
|||||||
getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a)
|
getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a)
|
||||||
putSum :: (Num w, Bits w, Binary w) => w -> w -> f a -> Put
|
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
|
getSum !code !size | code < sizeL = L1 <$> getSum code sizeL
|
||||||
| otherwise = R1 <$> getSum (code - sizeL) sizeR
|
| otherwise = R1 <$> getSum (code - sizeL) sizeR
|
||||||
where
|
where
|
||||||
|
@ -11,11 +11,6 @@ showPage dflag style = showDocWith dflag PageMode . withStyle dflag style
|
|||||||
showOneLine :: DynFlags -> PprStyle -> SDoc -> String
|
showOneLine :: DynFlags -> PprStyle -> SDoc -> String
|
||||||
showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style
|
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 :: GhcMonad m => m PprStyle
|
||||||
getStyle = do
|
getStyle = do
|
||||||
unqual <- getPrintUnqual
|
unqual <- getPrintUnqual
|
||||||
|
@ -63,23 +63,22 @@ loadMappedFile' from to isTemp = do
|
|||||||
let to' = makeRelative (cradleRootDir crdl) to
|
let to' = makeRelative (cradleRootDir crdl) to
|
||||||
addMMappedFile cfn (FileMapping to' isTemp)
|
addMMappedFile cfn (FileMapping to' isTemp)
|
||||||
|
|
||||||
mapFile :: (IOish m, GmState m, GhcMonad m, GmEnv m) =>
|
mapFile :: (IOish m, GmState m) => HscEnv -> Target -> m Target
|
||||||
HscEnv -> Target -> m Target
|
|
||||||
mapFile _ (Target tid@(TargetFile filePath _) taoc _) = do
|
mapFile _ (Target tid@(TargetFile filePath _) taoc _) = do
|
||||||
mapping <- lookupMMappedFile filePath
|
mapping <- lookupMMappedFile filePath
|
||||||
mkMappedTarget (Just filePath) tid taoc mapping
|
return $ mkMappedTarget (Just filePath) tid taoc mapping
|
||||||
mapFile env (Target tid@(TargetModule moduleName) taoc _) = do
|
mapFile env (Target tid@(TargetModule moduleName) taoc _) = do
|
||||||
(fp, mapping) <- do
|
(fp, mapping) <- do
|
||||||
filePath <- fmap (fmap mpPath) (liftIO $ findModulePath env moduleName)
|
filePath <- fmap (fmap mpPath) (liftIO $ findModulePath env moduleName)
|
||||||
mmf <- runMaybeT $ MaybeT (return filePath) >>= MaybeT . lookupMMappedFile
|
mmf <- runMaybeT $ MaybeT (return filePath) >>= MaybeT . lookupMMappedFile
|
||||||
return (filePath, mmf)
|
return (filePath, mmf)
|
||||||
mkMappedTarget fp tid taoc mapping
|
return $ mkMappedTarget fp tid taoc mapping
|
||||||
|
|
||||||
mkMappedTarget :: (IOish m, GmState m, GmEnv m, GhcMonad m) =>
|
mkMappedTarget :: Maybe FilePath -> TargetId -> Bool -> Maybe FileMapping -> Target
|
||||||
Maybe FilePath -> TargetId -> Bool -> Maybe FileMapping -> m Target
|
|
||||||
mkMappedTarget _ _ taoc (Just to) =
|
mkMappedTarget _ _ taoc (Just to) =
|
||||||
return $ mkTarget (TargetFile (fmPath to) Nothing) taoc Nothing
|
mkTarget (TargetFile (fmPath to) Nothing) taoc Nothing
|
||||||
mkMappedTarget _ tid taoc _ = return $ mkTarget tid taoc Nothing
|
mkMappedTarget _ tid taoc _ =
|
||||||
|
mkTarget tid taoc Nothing
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
unloads previously mapped file \'file\', so that it's no longer mapped,
|
unloads previously mapped file \'file\', so that it's no longer mapped,
|
||||||
|
@ -103,7 +103,7 @@ runGmOutT opts ma = do
|
|||||||
(const $ liftIO $ flushStdoutGateway gmoChan)
|
(const $ liftIO $ flushStdoutGateway gmoChan)
|
||||||
action
|
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
|
runGmOutT' gmo ma = flip runReaderT gmo $ unGmOutT ma
|
||||||
|
|
||||||
-- | Run a @GhcModT m@ computation.
|
-- | Run a @GhcModT m@ computation.
|
||||||
|
@ -290,8 +290,7 @@ findCandidates scns = foldl1 Set.intersection scns
|
|||||||
pickComponent :: Set ChComponentName -> ChComponentName
|
pickComponent :: Set ChComponentName -> ChComponentName
|
||||||
pickComponent scn = Set.findMin scn
|
pickComponent scn = Set.findMin scn
|
||||||
|
|
||||||
packageGhcOptions :: (Applicative m, IOish m, Gm m)
|
packageGhcOptions :: (IOish m, Applicative m, Gm m) => m [GHCOption]
|
||||||
=> m [GHCOption]
|
|
||||||
packageGhcOptions = do
|
packageGhcOptions = do
|
||||||
crdl <- cradle
|
crdl <- cradle
|
||||||
case cradleProject crdl of
|
case cradleProject crdl of
|
||||||
|
@ -271,7 +271,7 @@ instance Binary GmModuleGraph where
|
|||||||
mpGraph = Map.map (Set.map intToMp) $ Map.mapKeys intToMp graph
|
mpGraph = Map.map (Set.map intToMp) $ Map.mapKeys intToMp graph
|
||||||
return $ GmModuleGraph mpGraph
|
return $ GmModuleGraph mpGraph
|
||||||
where
|
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
|
swapMap = Map.fromList . map (\(x, y) -> (y, x)) . Map.toList
|
||||||
|
|
||||||
instance Monoid GmModuleGraph where
|
instance Monoid GmModuleGraph where
|
||||||
|
Loading…
Reference in New Issue
Block a user