{-# LANGUAGE
    Arrows
  , UnicodeSyntax
  #-}
module Rakka.Utils
    ( yesOrNo
    , trueOrFalse
    , parseYesOrNo
    , maybeA
    , deleteIfEmpty
    , chomp
    , guessMIMEType
    , isSafeChar
    , mkQueryString
    )
    where
import qualified Codec.Binary.Url as Url
import Control.Arrow
import Control.Arrow.ArrowList
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Lazy as LS
import Data.List
import qualified Data.Text as T
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)] → String
{-# INLINEABLE mkQueryString #-}
mkQueryString = intercalate ";" ∘ map pairToStr
    where
      pairToStr ∷ (T.Text, T.Text) → String
      {-# INLINE pairToStr #-}
      pairToStr (k, v)
          = encode k ⧺ ('=':encode v)

      encode ∷ T.Text → String
      {-# INLINE encode #-}
      encode = Url.encode ∘ BS.unpack ∘ encodeUtf8