{-# LANGUAGE
    RecordWildCards
  , TemplateHaskell
  , UnicodeSyntax
  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.HTTP.Lucu.OrphanInstances
    (
    )
    where
import Data.Ascii (Ascii)
import qualified Data.Ascii as A
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Strict
import qualified Data.ByteString.Lazy.Internal as Lazy
import Data.CaseInsensitive (CI, FoldCase)
import qualified Data.CaseInsensitive as CI
import Data.Map (Map)
import qualified Data.Map as M
import Data.Ratio
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax
import Prelude hiding (last, mapM, null, reverse)
import Prelude.Unicode

instance Lift ByteString where
    lift bs = [| Strict.pack $(litE $ stringL $ Strict.unpack bs) |]

instance Lift Lazy.ByteString where
    lift = Lazy.foldrChunks f [| Lazy.Empty |]
        where
          f ∷ ByteString → Q Exp → Q Exp
          f bs e = [| Lazy.Chunk $(lift bs) $e |]

instance Lift Ascii where
    lift a = [| A.unsafeFromByteString $(lift $ A.toByteString a) |]

instance (Lift s, FoldCase s) ⇒ Lift (CI s) where
    lift s = [| CI.mk $(lift $ CI.original s) |]

instance Lift Text where
    lift t = [| T.pack $(litE $ stringL $ T.unpack t) |]

instance (Lift k, Lift v) ⇒ Lift (Map k v) where
    lift m
        | M.null m = [| M.empty |]
        | otherwise = [| M.fromDistinctAscList $(liftPairs (M.toAscList m)) |]
        where
          liftPairs       = listE ∘ map liftPair
          liftPair (k, v) = tupE [lift k, lift v]

instance Lift UTCTime where
    lift (UTCTime {..})
        = [| UTCTime $(lift utctDay) $(lift utctDayTime) |]

instance Lift Day where
    lift (ModifiedJulianDay {..})
        = [| ModifiedJulianDay $(lift toModifiedJulianDay) |]

instance Lift DiffTime where
    lift dt = [| fromRational ($n % $d) ∷ DiffTime |]
        where
          n, d ∷ Q Exp
          n = lift $ numerator   $ toRational dt
          d = lift $ denominator $ toRational dt