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