]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/OrphanInstances.hs
Make sure RequestReader tells the writer to stop when the reader stops.
[Lucu.git] / Network / HTTP / Lucu / OrphanInstances.hs
1 {-# LANGUAGE
2     RecordWildCards
3   , TemplateHaskell
4   , UnicodeSyntax
5   #-}
6 {-# OPTIONS_GHC -fno-warn-orphans #-}
7 module Network.HTTP.Lucu.OrphanInstances
8     (
9     )
10     where
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
18 import Data.Map (Map)
19 import qualified Data.Map as M
20 import Data.Ratio
21 import Data.Text (Text)
22 import qualified Data.Text as T
23 import Data.Time
24 import Language.Haskell.TH.Lib
25 import Language.Haskell.TH.Syntax
26 import Prelude hiding (last, mapM, null, reverse)
27 import Prelude.Unicode
28
29 instance Lift ByteString where
30     lift bs = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]
31
32 instance Lift Lazy.ByteString where
33     lift = Lazy.foldrChunks f [| Lazy.Empty |]
34         where
35           f ∷ ByteString → Q Exp → Q Exp
36           f bs e = [| Lazy.Chunk $(lift bs) $e |]
37
38 instance Lift Ascii where
39     lift a = [| A.unsafeFromByteString $(lift $ A.toByteString a) |]
40
41 instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
42     lift s = [| CI.mk $(lift $ CI.original s) |]
43
44 instance Lift Text where
45     lift t = [| T.pack $(litE $ stringL $ T.unpack t) |]
46
47 instance (Lift k, Lift v) ⇒ Lift (Map k v) where
48     lift m
49         | M.null m = [| M.empty |]
50         | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
51         where
52           liftPairs       = listE ∘ map liftPair
53           liftPair (k, v) = tupE [lift k, lift v]
54
55 instance Lift UTCTime where
56     lift (UTCTime {..})
57         = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]
58
59 instance Lift Day where
60     lift (ModifiedJulianDay {..})
61         = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
62
63 instance Lift DiffTime where
64     lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
65         where
66           n, d ∷ Q Exp
67           n = lift $ numerator   $ toRational dt
68           d = lift $ denominator $ toRational dt