Network/HTTP/Lucu/OrphanInstances.hs

   1 {-# LANGUAGE
   2     FlexibleContexts
   3   , FlexibleInstances
   4   , OverlappingInstances
   5   , RecordWildCards
   6   , TemplateHaskell
   7   , UndecidableInstances
   8   , UnicodeSyntax
   9   #-}
  10 {-# OPTIONS_GHC -fno-warn-orphans #-}
  11 module Network.HTTP.Lucu.OrphanInstances
  12     (
  13     )
  14     where
  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 ()
  25 import Data.Ratio
  26 import Data.Text (Text)
  27 import qualified Data.Text as T
  28 import Data.Time
  29 import Language.Haskell.TH.Lib
  30 import Language.Haskell.TH.Syntax
  31 import Prelude hiding (last, mapM, null, reverse)
  32 import Prelude.Unicode
  33
  34 instance Lift ByteString where
  35     lift bs = [| Strict.pack $(litE ∘ stringL $ Strict.unpack bs) |]
  36
  37 instance Lift Lazy.ByteString where
  38     lift = Lazy.foldrChunks f [| Lazy.Empty |]
  39         where
  40           f ∷ ByteString → Q Exp → Q Exp
  41           f bs e = [| Lazy.Chunk $(lift bs) $e |]
  42
  43 instance Lift Ascii where
  44     lift a = [| A.unsafeFromByteString $(lift $ A.toByteString a) |]
  45
  46 instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
  47     lift s = [| CI.mk $(lift $ CI.original s) |]
  48
  49 instance Lift Text where
  50     lift t = [| T.pack $(litE ∘ stringL $ T.unpack t) |]
  51
  52 instance (Lift k, Lift v, Collection c (k, v)) ⇒ Lift c where
  53     lift c
  54         | null c    = [| empty |]
  55         | otherwise = [| fromList $(liftPairs (fromFoldable c)) |]
  56         where
  57           liftPairs       = listE ∘ (liftPair <$>)
  58           liftPair (k, v) = tupE [lift k, lift v]
  59
  60 instance Lift UTCTime where
  61     lift (UTCTime {..})
  62         = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]
  63
  64 instance Lift Day where
  65     lift (ModifiedJulianDay {..})
  66         = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]
  67
  68 instance Lift DiffTime where
  69     lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
  70         where
  71           n, d ∷ Q Exp
  72           n = lift ∘ numerator   $ toRational dt
  73           d = lift ∘ denominator $ toRational dt