X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FOrphanInstances.hs;h=8fa7e68714437b8270abb7b42d13e3ab35d360dc;hb=243b99439640480fc148d2e175247dacce04a222;hp=a7e7b7ee8d5ac42cc9b1e6a4bdff4a88c1905157;hpb=bb121f1189d01b5089aa5c29f0d390fad36ade48;p=Lucu.git

diff --git a/Network/HTTP/Lucu/OrphanInstances.hs b/Network/HTTP/Lucu/OrphanInstances.hs
index a7e7b7e..8fa7e68 100644
--- a/Network/HTTP/Lucu/OrphanInstances.hs
+++ b/Network/HTTP/Lucu/OrphanInstances.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE
-    RecordWildCards
+    FlexibleContexts
+  , FlexibleInstances
+  , RecordWildCards
+  , ScopedTypeVariables
   , TemplateHaskell
   , UnicodeSyntax
   #-}
@@ -8,6 +11,8 @@ module Network.HTTP.Lucu.OrphanInstances
     (
     )
     where
+import Control.Applicative hiding (empty)
+import Control.Monad
 import Data.Ascii (Ascii)
 import qualified Data.Ascii as A
 import Data.ByteString (ByteString)
@@ -15,7 +20,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 Data.Map (Map)
+import Data.Collections
+import Data.Collections.BaseInstances ()
 import qualified Data.Map as M
 import Data.Ratio
 import Data.Text (Text)
@@ -26,8 +32,14 @@ import Language.Haskell.TH.Syntax
 import Prelude hiding (last, mapM, null, reverse)
 import Prelude.Unicode
 
+instance Applicative Q where
+    {-# INLINE pure #-}
+    pure = return
+    {-# INLINE (<*>) #-}
+    (<*>) = ap
+
 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 |]
@@ -42,14 +54,17 @@ instance (Lift s, FoldCase s) ⇒ Lift (CI s) 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
-        | M.null m = [| M.empty |]
-        | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
+        | null m    = [| empty |]
+        | otherwise = [| fromAscList $(liftPairs (M.toAscList m)) |]
         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
@@ -64,5 +79,5 @@ instance Lift DiffTime where
     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