matchable-th 0.1.1.1 → 0.1.2.0

raw patch · 4 files changed

+28/−8 lines, 4 filesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• matchable-th.cabal +3/−2
• src/Data/Matchable/TH.hs +18/−6
• test/th.hs +1/−0

@@ -1,3 +1,9 @@+# 0.1.2.0++- Fail correctly, with appropriate error message, when deriving Matchable+  and Bimatchable fails due to the datatype having zero (Matchable) or+  less than two (Bimatchable) parameters.+ # 0.1.1.1  - Use "th-abstraction" >= 0.4 to cover changes in forthcoming

@@ -1,5 +1,5 @@ name:                matchable-th-version:             0.1.1.1+version:             0.1.2.0 synopsis:            Generates Matchable instances using TemplateHaskell description:         This package provides TemplateHaskell function to generate                      instances of @Matchable@ and @Bimatchable@ type classes,@@ -23,7 +23,7 @@   exposed-modules:      Data.Matchable.TH   build-depends:        base               >= 4.10       && <5,                         matchable          >= 0.1.2,-                        template-haskell   >= 2.4 && < 2.17,+                        template-haskell   >= 2.4 && < 2.18,                         th-abstraction     >= 0.4.0.0   ghc-options:          -Wall   default-language:     Haskell2010@@ -34,3 +34,4 @@   main-is:             th.hs   build-depends:       base, containers, matchable, matchable-th   default-language:    Haskell2010+

@@ -46,13 +46,19 @@ makeZipMatchWith :: Name -> ExpQ makeZipMatchWith name = makeZipMatchWith' name >>= snd +viewLast :: [a] -> Maybe ([a], a)+viewLast as = case reverse as of+  [] -> Nothing+  a:rest -> Just (reverse rest, a)+ makeZipMatchWith' :: Name -> Q ((Q Cxt, Type), ExpQ) makeZipMatchWith' name = do   info <- reifyDatatype name-  let DatatypeInfo { datatypeVars = dtVars , datatypeCons = cons } = info-      tyA : rest' = reverse (VarT . tvName <$> dtVars)-      dtFunctor = foldr (flip AppT) (ConT name) rest'-+  let DatatypeInfo { datatypeVars = dtVarsNames , datatypeCons = cons } = info+  (dtFunctor, tyA) <- case viewLast (VarT . tvName <$> dtVarsNames) of+    Nothing -> fail $ "Not a type constructor:" ++ show name+    Just (rest, tyA) -> return (foldl AppT (ConT name) rest, tyA)+     f <- newName "f"    let mkMatchClause (ConstructorInfo ctrName _ _ fields _ _) =@@ -218,12 +224,18 @@ makeBizipMatchWith :: Name -> ExpQ makeBizipMatchWith name = makeBizipMatchWith' name >>= snd +viewLastTwo :: [a] -> Maybe ([a],a,a)+viewLastTwo as = case reverse as of+  b:a:rest -> Just (reverse rest, a, b)+  _ -> Nothing+ makeBizipMatchWith' :: Name -> Q ((Q Cxt, Type), ExpQ) makeBizipMatchWith' name = do   info <- reifyDatatype name   let DatatypeInfo { datatypeVars = dtVars , datatypeCons = cons } = info-      tyB : tyA : rest' = reverse (VarT . tvName <$> dtVars)-      dtFunctor = foldr (flip AppT) (ConT name) rest'+  (dtFunctor, tyA, tyB) <- case viewLastTwo (VarT . tvName <$> dtVars) of+      Nothing -> fail $ "Not a datatype with at least 2 parameters: " ++ show name+      Just (rest, tyA, tyB) -> return (foldl AppT (ConT name) rest, tyA, tyB)    f <- newName "f"   g <- newName "g"

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-} module Main(main) where  import           Data.Functor.Classes