{-# LANGUAGE
    FlexibleContexts
  , OverloadedStrings
  , UnicodeSyntax
  #-}
-- |Utility functions used internally in this package.
module Network.HTTP.Lucu.Utils
    ( splitBy
    , quoteStr
    , parseWWWFormURLEncoded
    , uriPathSegments
    , trim

    , (⊲)
    , (⊳)
    , (⋈)
    , mapM

    , getLastModified
    )
    where
import Control.Applicative hiding (empty)
import Control.Monad hiding (mapM)
import Data.Ascii (Ascii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Strict
import Data.Char
import Data.Collections
import Data.Collections.BaseInstances ()
import Data.Monoid.Unicode
import Data.Ratio
import Data.Time
import Data.Time.Clock.POSIX
import Network.URI
import Prelude hiding (last, mapM, null, reverse)
import Prelude.Unicode
import System.Directory
import System.Time (ClockTime(..))

-- |>>> splitBy (== ':') "ab:c:def"
-- ["ab", "c", "def"]
splitBy ∷ (a → Bool) → [a] → [[a]]
{-# INLINEABLE splitBy #-}
splitBy isSep src
    = case break isSep src of
        (last , []       ) → [last]
        (first, _sep:rest) → first : splitBy isSep rest

-- |>>> quoteStr "abc"
-- "\"abc\""
--
-- >>> quoteStr "ab\"c"
-- "\"ab\\\"c\""
quoteStr ∷ Ascii → AsciiBuilder
quoteStr str = A.toAsciiBuilder "\"" ⊕
               go (A.toByteString str) (∅) ⊕
               A.toAsciiBuilder "\""
    where
      go ∷ Strict.ByteString → AsciiBuilder → AsciiBuilder
      go bs ab
          = case Strict.break (≡ '"') bs of
              (x, y)
                  | Strict.null y
                      → ab ⊕ b2ab x
                  | otherwise
                      → go (Strict.tail y)
                           (ab ⊕ b2ab x ⊕ A.toAsciiBuilder "\\\"")

      b2ab ∷ Strict.ByteString → AsciiBuilder
      b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString

-- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
-- [("aaa", "bbb"), ("ccc", "ddd")]
parseWWWFormURLEncoded ∷ Ascii → [(ByteString, ByteString)]
parseWWWFormURLEncoded src
    -- THINKME: We could gain some performance by using attoparsec
    -- here.
    | src ≡ ""  = []
    | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (A.toString src)
                     let (key, value) = break (≡ '=') pairStr
                     return ( unescape key
                            , unescape $ case value of
                                           ('=':val) → val
                                           val       → val
                            )
    where
      unescape ∷ String → ByteString
      unescape = Strict.pack ∘ unEscapeString ∘ (plusToSpace <$>)

      plusToSpace ∷ Char → Char
      plusToSpace '+' = ' '
      plusToSpace c   = c

-- |>>> uriPathSegments "http://example.com/foo/bar"
-- ["foo", "bar"]
uriPathSegments ∷ URI → [ByteString]
uriPathSegments uri
    = let reqPathStr = uriPath uri
          reqPath    = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
      in
        Strict.pack <$> reqPath

-- |>>> trim "  ab c d "
-- "ab c d"
trim ∷ String → String
trim = reverse ∘ f ∘ reverse ∘ f
    where
      f = dropWhile isSpace

infixr 5 ⊲
-- | (&#22B2;) = ('<|')
--
-- U+22B2, NORMAL SUBGROUP OF
(⊲) ∷ Sequence α a ⇒ a → α → α
(⊲) = (<|)

infixl 5 ⊳
-- | (&#22B3;) = ('|>')
--
-- U+22B3, CONTAINS AS NORMAL SUBGROUP
(⊳) ∷ Sequence α a ⇒ α → a → α
(⊳) = (|>)

infixr 5 ⋈
-- | (&#22C8;) = ('><')
--
-- U+22C8, BOWTIE
(⋈) ∷ Sequence α a ⇒ α → α → α
(⋈) = (><)

-- |Generalised @mapM@ from any 'Foldable' to 'Unfoldable'. Why isn't
-- this in the @collections-api@?
mapM ∷ (Foldable α a, Unfoldable β b, Functor m, Monad m)
     ⇒ (a → m b) → α → m β
{-# INLINE mapM #-}
mapM = flip foldrM empty ∘ (flip ((<$>) ∘ flip insert) ∘)

-- |Get the modification time of a given file.
getLastModified ∷ FilePath → IO UTCTime
getLastModified = (clockTimeToUTC <$>) ∘ getModificationTime
    where
      clockTimeToUTC ∷ ClockTime → UTCTime
      clockTimeToUTC (TOD sec picoSec)
          = posixSecondsToUTCTime ∘ fromRational
            $ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000)