{-# LANGUAGE
    FlexibleContexts
  , FlexibleInstances
  , RecordWildCards
  , ScopedTypeVariables
  , TemplateHaskell
  , UnicodeSyntax
  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.HTTP.Lucu.OrphanInstances
    (
    )
    where
import Control.Applicative hiding (empty)
import Control.Monad
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.Collections
import Data.Collections.BaseInstances ()
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 Applicative Q where
    {-# INLINE pure #-}
    pure = return
    {-# INLINE (<*>) #-}
    (<*>) = ap

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 (M.Map k v) where
    lift m
        | null m    = [| empty |]
        | otherwise = [| fromAscList $(liftPairs (M.toAscList m)) |]
        where
          liftPairs ∷ [(k, v)] → Q Exp
          liftPairs = listE ∘ (liftPair <$>)

          liftPair ∷ (k, v) → Q Exp
          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