git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix generic deriving bug with >1 type argument
ab5af88Harry Garrood
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+8−5
@@ -17,6 +17,7 @@ import Data.List (foldl', find, sortBy)
17import Data.Maybe (fromMaybe)
17import Data.Maybe (fromMaybe)
18import Data.Ord (comparing)
18import Data.Ord (comparing)
19
19
20+import Control.Arrow (second)
20import Control.Monad (replicateM)
21import Control.Monad (replicateM)
21import Control.Monad.Supply.Class (MonadSupply)
22import Control.Monad.Supply.Class (MonadSupply)
22import Control.Monad.Error.Class (MonadError(..))
23import Control.Monad.Error.Class (MonadError(..))
@@ -55,11 +56,13 @@ deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration p
55deriveInstance _ _ e = return e
56deriveInstance _ _ e = return e
56
57
57unwrapTypeConstructor :: Type -> Maybe (Qualified (ProperName 'TypeName), [Type])
58unwrapTypeConstructor :: Type -> Maybe (Qualified (ProperName 'TypeName), [Type])
59+unwrapTypeConstructor = fmap (second reverse) . go
60+ where
58−unwrapTypeConstructor (TypeConstructor tyCon) = Just (tyCon, [])
61+ go (TypeConstructor tyCon) = Just (tyCon, [])
59−unwrapTypeConstructor (TypeApp ty arg) = do
62+ go (TypeApp ty arg) = do
60− (tyCon, args) <- unwrapTypeConstructor ty
63+ (tyCon, args) <- go ty
61− return (tyCon, arg : args)
64+ return (tyCon, arg : args)
62−unwrapTypeConstructor _ = Nothing
65+ go _ = Nothing
63
66
64dataGeneric :: ModuleName
67dataGeneric :: ModuleName
65dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
68dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]