9 {-# OPTIONS_GHC -fno-warn-orphans #-}
10 module Network.HTTP.Lucu.OrphanInstances
14 import Control.Applicative hiding (empty)
16 import Data.Ascii (Ascii)
17 import qualified Data.Ascii as A
18 import Data.ByteString (ByteString)
19 import qualified Data.ByteString.Char8 as Strict
20 import qualified Data.ByteString.Lazy.Internal as Lazy
21 import Data.CaseInsensitive (CI, FoldCase)
22 import qualified Data.CaseInsensitive as CI
23 import Data.Collections
24 import Data.Collections.BaseInstances ()
25 import qualified Data.Map as M
27 import Data.Text (Text)
28 import qualified Data.Text as T
30 import Language.Haskell.TH.Lib
31 import Language.Haskell.TH.Syntax
32 import Prelude hiding (last, mapM, null, reverse)
33 import Prelude.Unicode
35 instance Applicative Q where
41 instance Lift ByteString where
42 lift bs = [| Strict.pack $(litE ∘ stringL $ Strict.unpack bs) |]
44 instance Lift Lazy.ByteString where
45 lift = Lazy.foldrChunks f [| Lazy.Empty |]
47 f ∷ ByteString → Q Exp → Q Exp
48 f bs e = [| Lazy.Chunk $(lift bs) $e |]
50 instance Lift Ascii where
51 lift a = [| A.unsafeFromByteString $(lift $ A.toByteString a) |]
53 instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
54 lift s = [| CI.mk $(lift $ CI.original s) |]
56 instance Lift Text where
57 lift t = [| T.pack $(litE ∘ stringL $ T.unpack t) |]
59 instance (Lift k, Lift v) ⇒ Lift (M.Map k v) where
61 | null m = [| empty |]
62 | otherwise = [| fromAscList $(liftPairs (M.toAscList m)) |]
64 liftPairs ∷ [(k, v)] → Q Exp
65 liftPairs = listE ∘ (liftPair <$>)
67 liftPair ∷ (k, v) → Q Exp
68 liftPair (k, v) = tupE [lift k, lift v]
70 instance Lift UTCTime where
72 = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]
74 instance Lift Day where
75 lift (ModifiedJulianDay {..})
76 = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
78 instance Lift DiffTime where
79 lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
82 n = lift ∘ numerator $ toRational dt
83 d = lift ∘ denominator $ toRational dt