Add changelog, remove extraneous whitespace and unused code comments.

obsidiansystems · Dec 17, 2021 · a96d9bf · a96d9bf
1 parent fe43c81
commit a96d9bf
Show file tree

Hide file tree

Showing 4 changed files with 12 additions and 15 deletions.
diff --git a/dependent-sum-template/ChangeLog.md b/dependent-sum-template/ChangeLog.md
@@ -1,5 +1,11 @@
 # Revision history for dependent-sum-template
 
+## Pending release
+
+* Rework a lot of the logic using th-abstraction to get structural information about data types and to
+  normalize their representation. This should allow the deriving functions to work on a much wider range
+  of types.
+
 ## 0.1.1.1 - 2021-12-30
 
 * Fix warning with GHC 9.2 about non-canonical `return`.

diff --git a/dependent-sum-template/src/Data/Dependent/Sum/TH/Internal.hs b/dependent-sum-template/src/Data/Dependent/Sum/TH/Internal.hs
@@ -55,7 +55,7 @@ subst :: Map Name Type -> Type -> Type
 subst s = f
   where
     f = \case
-      ForallT bndrs cxt t -> 
+      ForallT bndrs cxt t ->
         let s' = Map.difference s (Map.fromList [(k,()) | k <- map tvName bndrs])
         in ForallT bndrs cxt (subst s' t)
       AppT t t' -> AppT (f t) (f t')
@@ -126,10 +126,3 @@ classHeadToParams t = (h, reverse reversedParams)
         let (h, reversedParams) = classHeadToParams f
         in (h, x : reversedParams)
       _ -> (headOfType t, [])
-{-
-makeTopVars :: Name -> Q [Name]
-makeTopVars tyConName = do
-  (tyVarBndrs, kArity) <- tyConArity' tyConName
-  extraVars <- replicateM kArity (newName "")
-  return (map tvName tyVarBndrs ++ extraVars)
--}
diff --git a/dependent-sum-template/src/Data/GADT/Compare/TH.hs b/dependent-sum-template/src/Data/GADT/Compare/TH.hs
@@ -88,7 +88,7 @@ geqClause paramVars con = do
   ret <- lift $ noBindS [| return Refl |]
 
   return $ Clause
-    [ ConP conName (map VarP lArgNames) 
+    [ ConP conName (map VarP lArgNames)
     , ConP conName (map VarP rArgNames) ]
     ( NormalB (doUnqualifiedE (stmts ++ [ret])))
     []
@@ -135,10 +135,10 @@ gcompareClauses paramVars con = do
       conTyVars = Set.fromList (map tvName (constructorVars con))
       needsGCompare argType = not . Set.null $
         Set.intersection (freeTypeVariables argType) (Set.union paramVars conTyVars)
-  
+
   lArgNames <- forM argTypes $ \_ -> lift $ newName "x"
   rArgNames <- forM argTypes $ \_ -> lift $ newName "y"
-  
+
   stmts <- forM (zip3 lArgNames rArgNames argTypes) $ \(lArg, rArg, argType) ->
     case argType of
       AppT tyFun tyArg | needsGCompare argType -> do
@@ -153,7 +153,7 @@ gcompareClauses paramVars con = do
   ret <- lift $ noBindS [| return GEQ |]
 
   let main = Clause
-        [ ConP conName (map VarP lArgNames) 
+        [ ConP conName (map VarP lArgNames)
         , ConP conName (map VarP rArgNames) ]
         ( NormalB (AppE (VarE 'runGComparing) (doUnqualifiedE (stmts ++ [ret]))))
         []

diff --git a/dependent-sum-template/src/Data/GADT/Show/TH.hs b/dependent-sum-template/src/Data/GADT/Show/TH.hs
@@ -65,16 +65,14 @@ gshowClause typeName paramVars con = do
   precName <- lift $ newName "prec"
   argNames <- forM argTypes $ \_ -> lift $ newName "x"
 
-
-
   argShowExprs <- forM (zip argNames argTypes) $ \(n,t) -> do
     let useShow = do
           tell [AppT (ConT ''Show) t]
           return [| showsPrec 11 $(varE n) |]
     case t of
       AppT tyFun tyArg -> do
         let useGShow = do
-              tell [AppT (ConT ''GShow) tyFun] 
+              tell [AppT (ConT ''GShow) tyFun]
               return [| gshowsPrec 11 $(varE n) |]
         if isApplicationOf (ConT typeName) tyFun
           then return [| gshowsPrec 11 $(varE n) |]