Code reorganisation

[Lucu.git] / Network / HTTP / Lucu / OrphanInstances.hs

diff --git a/Network/HTTP/Lucu/OrphanInstances.hs b/Network/HTTP/Lucu/OrphanInstances.hs
index a7e7b7ee8d5ac42cc9b1e6a4bdff4a88c1905157..8fa7e68714437b8270abb7b42d13e3ab35d360dc 100644 (file)
--- a/Network/HTTP/Lucu/OrphanInstances.hs
+++ b/Network/HTTP/Lucu/OrphanInstances.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE
 {-# LANGUAGE

-    RecordWildCards
+    FlexibleContexts
+  , FlexibleInstances
+  , RecordWildCards
+  , ScopedTypeVariables

   , TemplateHaskell
   , UnicodeSyntax
   #-}
   , TemplateHaskell
   , UnicodeSyntax
   #-}


@@ -8,6 +11,8 @@ module Network.HTTP.Lucu.OrphanInstances
     (
     )
     where
     (
     )
     where

+import Control.Applicative hiding (empty)
+import Control.Monad

 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 +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 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)


@@ -26,8 +32,14 @@ import Language.Haskell.TH.Syntax
 import Prelude hiding (last, mapM, null, reverse)
 import Prelude.Unicode
 
 import Prelude hiding (last, mapM, null, reverse)
 import Prelude.Unicode
 

+instance Applicative Q where
+    {-# INLINE pure #-}
+    pure = return
+    {-# INLINE (<*>) #-}
+    (<*>) = ap
+

 instance Lift ByteString where
 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 +54,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 +79,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