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