]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/OrphanInstances.hs
It must be a bad idea to expose overlapped orphan instances.
[Lucu.git] / Network / HTTP / Lucu / OrphanInstances.hs
index 47db98b7dee176f73da96f3ac9e79556c53fdc0f..333e162cdf5075bb1230059ddc723c13d5bb927a 100644 (file)
@@ -1,10 +1,9 @@
 {-# LANGUAGE
     FlexibleContexts
   , FlexibleInstances
-  , OverlappingInstances
   , RecordWildCards
+  , ScopedTypeVariables
   , TemplateHaskell
-  , UndecidableInstances
   , UnicodeSyntax
   #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -22,6 +21,7 @@ import Data.CaseInsensitive (CI, FoldCase)
 import qualified Data.CaseInsensitive as CI
 import Data.Collections
 import Data.Collections.BaseInstances ()
+import qualified Data.Map as M
 import Data.Ratio
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -49,12 +49,15 @@ instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
 instance Lift Text where
     lift t = [| T.pack $(litE ∘ stringL $ T.unpack t) |]
 
-instance (Lift k, Lift v, Collection c (k, v)) ⇒ Lift c where
-    lift c
-        | null c    = [| empty |]
-        | otherwise = [| fromList $(liftPairs (fromFoldable c)) |]
+instance (Lift k, Lift v) ⇒ Lift (M.Map k v) where
+    lift m
+        | null m    = [| empty |]
+        | otherwise = [| fromAscList $(liftPairs (M.toAscList m)) |]
         where
-          liftPairs       = listE ∘ (liftPair <$>)
+          liftPairs ∷ [(k, v)] → Q Exp
+          liftPairs = listE ∘ (liftPair <$>)
+
+          liftPair ∷ (k, v) → Q Exp
           liftPair (k, v) = tupE [lift k, lift v]
 
 instance Lift UTCTime where