{-# LANGUAGE
    Arrows
  , UnicodeSyntax
  #-}
module Rakka.Utils
    ( yesOrNo
    , trueOrFalse
    , parseYesOrNo
    , maybeA
    , deleteIfEmpty
    , chomp
    , guessMIMEType
    , isSafeChar
    , mkQueryString
    )
    where
import qualified Blaze.ByteString.Builder as BBB
import Control.Arrow
import Control.Arrow.ArrowList
import Data.Ascii (Ascii)
import qualified Data.Ascii as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Lazy as LS
import Data.Monoid.Unicode
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Encoding
import Magic
import Network.HTTP.Lucu
import Network.URI
import Prelude.Unicode
import System.IO.Unsafe

yesOrNo ∷ Bool → String
yesOrNo True  = "yes"
yesOrNo False = "no"

trueOrFalse ∷ Bool → String
trueOrFalse True  = "true"
trueOrFalse False = "false"

parseYesOrNo ∷ ArrowChoice a ⇒ a String Bool
parseYesOrNo 
    = proc str → do case str of
                       "yes" → returnA ⤙ True
                       "no"  → returnA ⤙ False
                       _     → returnA ⤙ error ("Expected yes or no: " ⧺ str)

maybeA ∷ (ArrowList a, ArrowChoice a) ⇒ a b c → a b (Maybe c)
maybeA a = listA a
           >>>
           proc xs → case xs of
                        []    → returnA ⤙ Nothing
                        (x:_) → returnA ⤙ Just x

deleteIfEmpty ∷ (ArrowList a, ArrowChoice a) ⇒ a String String
deleteIfEmpty
    = proc str → do case str of
                       "" → none    ⤙ ()
                       _  → returnA ⤙ str

chomp ∷ String → String
{-# INLINE chomp #-}
chomp = reverse . snd . break (≢ '\n') . reverse

guessMIMEType ∷ LS.ByteString → MIMEType
{-# INLINEABLE guessMIMEType #-}
guessMIMEType = read
                ∘ unsafePerformIO
                ∘ flip BS.unsafeUseAsCStringLen (magicCString magic)
                ∘ BS.concat
                ∘ LS.toChunks
    where
      magic ∷ Magic
      {-# NOINLINE magic #-}
      magic = unsafePerformIO
              $ do m ← magicOpen [MagicMime]
                   magicLoadDefault m
                   return m

isSafeChar ∷ Char → Bool
{-# INLINEABLE isSafeChar #-}
isSafeChar c
    | c ≡ '/'        = True
    | isReserved c   = False
    | isUnreserved c = True
    | otherwise      = False

mkQueryString ∷ [(T.Text, T.Text)] → Ascii
{-# INLINE mkQueryString #-}
mkQueryString = A.unsafeFromByteString
                ∘ BBB.toByteString
                ∘ flip mkBBB (∅)
    where
      mkBBB ∷ [(T.Text, T.Text)] → BBB.Builder → BBB.Builder
      {-# INLINEABLE mkBBB #-}
      mkBBB []      acc = acc
      mkBBB (kv:[]) acc = acc ⊕ pair kv
      mkBBB (kv:xs) acc = mkBBB xs (acc ⊕ pair kv ⊕ semicolon)

      pair ∷ (T.Text, T.Text) → BBB.Builder
      {-# INLINE pair #-}
      pair (k, v)
          = encodeText k ⊕ equal ⊕ encodeText v

      encodeText ∷ T.Text → BBB.Builder
      {-# INLINE encodeText #-}
      encodeText = BBB.fromByteString ∘ URI.encode ∘ encodeUtf8