th-instance-reification 0.1.0 → 0.1.1

raw patch · 4 files changed

+26/−10 lines, 4 filesdep +list-extrasdep +th-expand-syns

Dependencies added: list-extras, th-expand-syns

Files

• src/THInstanceReification.hs +13/−7
• src/THInstanceReification/Prelude/Basic.hs +3/−0
• src/THInstanceReification/Prelude/TH.hs +1/−0
• th-instance-reification.cabal +9/−3

@@ -35,23 +35,29 @@ -- It simply considers them to be true. typesSatisfyDecConstraints :: [Type] -> InstanceDec -> Q Bool typesSatisfyDecConstraints tl = \case-  InstanceD c it _ -> let-    ([ConT n], htl) = splitAt 1 $ reverse $ unapplyType it-    in analyze c n htl+  InstanceD c it _ -> do+    let ([ConT n], htl) = splitAt 1 $ reverse $ unapplyType it+    etl <- mapM expandSyns tl+    ehtl <- mapM expandSyns htl+    maybe +      (fail $ "Unmatching amounts of types: " <> show etl <> ", " <> show ehtl)+      (analyze c n)+      (pair etl ehtl)   d -> fail $ "Not an instance dec: " <> show d   where-    analyze c n htl = and <$> mapM analyzeConstraint c+    analyze c n pl = and <$> mapM analyzeConstraint c       where         actualTypeByVarName = \n ->           Map.lookup n m ?: -          ($bug $ "Unexpected key: " <> show n <> ", in a map: " <> show m)+          ($bug $ "Unexpected key: " <> show n <> ", in a map: " <> show m <> +                  ", from a list: " <> show tl)           where-            m = Map.fromList $ concat $ map accRecords $ zip tl htl+            m = Map.fromList $ concat $ map accRecords $ pl               where                 accRecords = \case                   (AppT al ar, AppT hl hr) -> accRecords (al, hl) ++ accRecords (ar, hr)                   (a, VarT n) -> [(n, a)]-                  (a, h) | a /= h -> fail $ "Unmatching types: " <> show a <> ", " <> show h+                  (a, h) | a /= h -> $bug $ "Unmatching types: " <> show a <> ", " <> show h                   _ -> []         analyzeConstraint = \case           EqualP _ _ -> return True

@@ -55,6 +55,9 @@ -- placeholders import Development.Placeholders as Exports +-- list-extras+import Data.List.Extras as Exports+  import qualified Debug.Trace.LocationTH 

@@ -9,6 +9,7 @@  import THInstanceReification.Prelude.Basic import Language.Haskell.TH as Exports+import Language.Haskell.TH.ExpandSyns as Exports   purify :: Q a -> a

@@ -1,7 +1,7 @@ name:   th-instance-reification version:-  0.1.0+  0.1.1 synopsis:   Fixed versions of instances reification functions description:@@ -51,8 +51,11 @@     -- debugging:     loch-th == 0.2.*,     placeholders == 0.1.*,-    -- general:+    -- template-haskell:+    th-expand-syns == 0.3.*,     template-haskell,+    -- general:+    list-extras == 0.4.*,     base >= 4.5 && < 5   default-extensions:     Arrows@@ -112,8 +115,11 @@     -- debugging:     loch-th == 0.2.*,     placeholders == 0.1.*,-    -- general:+    -- template-haskell:+    th-expand-syns == 0.3.*,     template-haskell,+    -- general:+    list-extras == 0.4.*,     base >= 4.5 && < 5   default-extensions:     Arrows