10 {-# OPTIONS_GHC -fno-warn-orphans #-}
11 module Network.HTTP.Lucu.OrphanInstances
15 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 ()
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, Collection c (k, v)) ⇒ Lift c where
54 | null c = [| empty |]
55 | otherwise = [| fromList $(liftPairs (fromFoldable c)) |]
57 liftPairs = listE ∘ (liftPair <$>)
58 liftPair (k, v) = tupE [lift k, lift v]
60 instance Lift UTCTime where
62 = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]
64 instance Lift Day where
65 lift (ModifiedJulianDay {..})
66 = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
68 instance Lift DiffTime where
69 lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
72 n = lift ∘ numerator $ toRational dt
73 d = lift ∘ denominator $ toRational dt