]> 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 a7e7b7ee8d5ac42cc9b1e6a4bdff4a88c1905157..333e162cdf5075bb1230059ddc723c13d5bb927a 100644 (file)
@@ -1,5 +1,8 @@
 {-# LANGUAGE
 {-# LANGUAGE
-    RecordWildCards
+    FlexibleContexts
+  , FlexibleInstances
+  , RecordWildCards
+  , ScopedTypeVariables
   , TemplateHaskell
   , UnicodeSyntax
   #-}
   , TemplateHaskell
   , UnicodeSyntax
   #-}
@@ -8,6 +11,7 @@ module Network.HTTP.Lucu.OrphanInstances
     (
     )
     where
     (
     )
     where
+import Control.Applicative hiding (empty)
 import Data.Ascii (Ascii)
 import qualified Data.Ascii as A
 import Data.ByteString (ByteString)
 import Data.Ascii (Ascii)
 import qualified Data.Ascii as A
 import Data.ByteString (ByteString)
@@ -15,7 +19,8 @@ import qualified Data.ByteString.Char8 as Strict
 import qualified Data.ByteString.Lazy.Internal as Lazy
 import Data.CaseInsensitive (CI, FoldCase)
 import qualified Data.CaseInsensitive as CI
 import qualified Data.ByteString.Lazy.Internal as Lazy
 import Data.CaseInsensitive (CI, FoldCase)
 import qualified Data.CaseInsensitive as CI
-import Data.Map (Map)
+import Data.Collections
+import Data.Collections.BaseInstances ()
 import qualified Data.Map as M
 import Data.Ratio
 import Data.Text (Text)
 import qualified Data.Map as M
 import Data.Ratio
 import Data.Text (Text)
@@ -27,7 +32,7 @@ import Prelude hiding (last, mapM, null, reverse)
 import Prelude.Unicode
 
 instance Lift ByteString where
 import Prelude.Unicode
 
 instance Lift ByteString where
-    lift bs = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
+    lift bs = [| Strict.pack $(litE  stringL $ Strict.unpack bs) |]
 
 instance Lift Lazy.ByteString where
     lift = Lazy.foldrChunks f [| Lazy.Empty |]
 
 instance Lift Lazy.ByteString where
     lift = Lazy.foldrChunks f [| Lazy.Empty |]
@@ -42,14 +47,17 @@ instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
     lift s = [| CI.mk $(lift $ CI.original s) |]
 
 instance Lift Text where
     lift s = [| CI.mk $(lift $ CI.original s) |]
 
 instance Lift Text where
-    lift t = [| T.pack $(litE $ stringL $ T.unpack t) |]
+    lift t = [| T.pack $(litE  stringL $ T.unpack t) |]
 
 
-instance (Lift k, Lift v) ⇒ Lift (Map k v) where
+instance (Lift k, Lift v) ⇒ Lift (M.Map k v) where
     lift m
     lift m
-        | M.null m = [| M.empty |]
-        | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
+        | null m    = [| empty |]
+        | otherwise = [| fromAscList $(liftPairs (M.toAscList m)) |]
         where
         where
-          liftPairs       = listE ∘ map 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
           liftPair (k, v) = tupE [lift k, lift v]
 
 instance Lift UTCTime where
@@ -64,5 +72,5 @@ instance Lift DiffTime where
     lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
         where
           n, d ∷ Q Exp
     lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
         where
           n, d ∷ Q Exp
-          n = lift $ numerator   $ toRational dt
-          d = lift $ denominator $ toRational dt
+          n = lift  numerator   $ toRational dt
+          d = lift  denominator $ toRational dt