git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix redundant case warning in derived Ord instances
6bbecf2Phil Freeman
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+21−13
compare with golang
unifiedsplit
@@ -290,34 +290,42 @@ deriveOrd mn ds tyConNm = do
290 mkCompareFunction (DataDeclaration _ _ _ args) = do
290 mkCompareFunction (DataDeclaration _ _ _ args) = do
291 x <- freshIdent "x"
291 x <- freshIdent "x"
292 y <- freshIdent "y"
292 y <- freshIdent "y"
293− lamCase2 x y <$> (concat <$> mapM mkCtorClauses args)
293+ lamCase2 x y <$> (concat <$> mapM mkCtorClauses (splitLast args))
294 mkCompareFunction (PositionedDeclaration _ _ d) = mkCompareFunction d
294 mkCompareFunction (PositionedDeclaration _ _ d) = mkCompareFunction d
295 mkCompareFunction _ = internalError "mkCompareFunction: expected DataDeclaration"
295 mkCompareFunction _ = internalError "mkCompareFunction: expected DataDeclaration"
296
296
297+ splitLast :: [a] -> [(a, Bool)]
298+ splitLast [] = []
299+ splitLast [x] = [(x, True)]
300+ splitLast (x : xs) = (x, False) : splitLast xs
301+
297 preludeCtor :: String -> Expr
302 preludeCtor :: String -> Expr
298 preludeCtor = Constructor . Qualified (Just (ModuleName [ProperName C.prelude])) . ProperName
303 preludeCtor = Constructor . Qualified (Just (ModuleName [ProperName C.prelude])) . ProperName
299
304
300 preludeCompare :: Expr -> Expr -> Expr
305 preludeCompare :: Expr -> Expr -> Expr
301 preludeCompare = App . App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.compare)))
306 preludeCompare = App . App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.compare)))
302
307
303− mkCtorClauses :: (ProperName 'ConstructorName, [Type]) -> m [CaseAlternative]
308+ mkCtorClauses :: ((ProperName 'ConstructorName, [Type]), Bool) -> m [CaseAlternative]
304− mkCtorClauses (ctorName, tys) = do
309+ mkCtorClauses ((ctorName, tys), isLast) = do
305 identsL <- replicateM (length tys) (freshIdent "l")
310 identsL <- replicateM (length tys) (freshIdent "l")
306 identsR <- replicateM (length tys) (freshIdent "r")
311 identsR <- replicateM (length tys) (freshIdent "r")
307 let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys
312 let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys
313+ extras | not isLast = [ CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
314+ , NullBinder
315+ ]
316+ (Right (preludeCtor "LT"))
317+ , CaseAlternative [ NullBinder
318+ , ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
319+ ]
320+ (Right (preludeCtor "GT"))
321+ ]
322+ | otherwise = []
308− return [ CaseAlternative [ caseBinder identsL
323+ return $ CaseAlternative [ caseBinder identsL
309 , caseBinder identsR
324 , caseBinder identsR
310 ]
325 ]
311 (Right (appendAll tests))
326 (Right (appendAll tests))
312− , CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
327+ : extras
313− , NullBinder
328+
314− ]
315− (Right (preludeCtor "LT"))
316− , CaseAlternative [ NullBinder
317− , ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
318− ]
319− (Right (preludeCtor "GT"))
320− ]
321 where
329 where
322 caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)
330 caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)
323
331