6 {-# OPTIONS_GHC -fno-warn-orphans #-}
7 module Network.HTTP.Lucu.OrphanInstances
11 import Data.Ascii (Ascii)
12 import qualified Data.Ascii as A
13 import Data.ByteString (ByteString)
14 import qualified Data.ByteString.Char8 as Strict
15 import qualified Data.ByteString.Lazy.Internal as Lazy
16 import Data.CaseInsensitive (CI, FoldCase)
17 import qualified Data.CaseInsensitive as CI
19 import qualified Data.Map as M
21 import Data.Text (Text)
22 import qualified Data.Text as T
24 import Language.Haskell.TH.Lib
25 import Language.Haskell.TH.Syntax
26 import Prelude hiding (last, mapM, null, reverse)
27 import Prelude.Unicode
29 instance Lift ByteString where
30 lift bs = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
32 instance Lift Lazy.ByteString where
33 lift = Lazy.foldrChunks f [| Lazy.Empty |]
35 f ∷ ByteString → Q Exp → Q Exp
36 f bs e = [| Lazy.Chunk $(lift bs) $e |]
38 instance Lift Ascii where
39 lift a = [| A.unsafeFromByteString $(lift $ A.toByteString a) |]
41 instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
42 lift s = [| CI.mk $(lift $ CI.original s) |]
44 instance Lift Text where
45 lift t = [| T.pack $(litE $ stringL $ T.unpack t) |]
47 instance (Lift k, Lift v) ⇒ Lift (Map k v) where
49 | M.null m = [| M.empty |]
50 | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
52 liftPairs = listE ∘ map liftPair
53 liftPair (k, v) = tupE [lift k, lift v]
55 instance Lift UTCTime where
57 = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]
59 instance Lift Day where
60 lift (ModifiedJulianDay {..})
61 = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
63 instance Lift DiffTime where
64 lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
67 n = lift $ numerator $ toRational dt
68 d = lift $ denominator $ toRational dt