10 {-# OPTIONS_GHC -fno-warn-orphans #-}
11 module Network.HTTP.Lucu.OrphanInstances
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 ()
25 import Data.Text (Text)
26 import qualified Data.Text as T
28 import Language.Haskell.TH.Lib
29 import Language.Haskell.TH.Syntax
30 import Prelude hiding (last, mapM, null, reverse)
31 import Prelude.Unicode
33 instance Lift ByteString where
34 lift bs = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
36 instance Lift Lazy.ByteString where
37 lift = Lazy.foldrChunks f [| Lazy.Empty |]
39 f ∷ ByteString → Q Exp → Q Exp
40 f bs e = [| Lazy.Chunk $(lift bs) $e |]
42 instance Lift Ascii where
43 lift a = [| A.unsafeFromByteString $(lift $ A.toByteString a) |]
45 instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
46 lift s = [| CI.mk $(lift $ CI.original s) |]
48 instance Lift Text where
49 lift t = [| T.pack $(litE $ stringL $ T.unpack t) |]
51 instance (Lift k, Lift v, Collection c (k, v)) ⇒ Lift c where
53 | null c = [| empty |]
54 | otherwise = [| fromList $(liftPairs (fromFoldable c)) |]
56 liftPairs = listE ∘ map liftPair
57 liftPair (k, v) = tupE [lift k, lift v]
59 instance Lift UTCTime where
61 = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]
63 instance Lift Day where
64 lift (ModifiedJulianDay {..})
65 = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
67 instance Lift DiffTime where
68 lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
71 n = lift $ numerator $ toRational dt
72 d = lift $ denominator $ toRational dt