{-# LANGUAGE
    Arrows
  , OverloadedStrings
  , TypeOperators
  , UnicodeSyntax
  #-}
module Rakka.Utils
    ( yesOrNo
    , trueOrFalse
    , parseYesOrNo
    , maybeA
    , deleteIfEmpty
    , chomp
    , guessMIMEType
    , isSafeChar
    , mkQueryString
    )
    where
import qualified Codec.Binary.UTF8.String as UTF8
import           Control.Arrow
import           Control.Arrow.ArrowList
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
import Data.Monoid.Unicode
import Data.String
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 ∷ (Eq s, Show s, IsString s, ArrowChoice (⇝)) ⇒ s ⇝ Bool
parseYesOrNo
    = proc str →
      case str of
        _ | str ≡ "yes" → returnA ⤙ True
          | str ≡ "no"  → returnA ⤙ False
          | otherwise   → returnA ⤙ error ("Expected yes or no: " ⊕ show 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
chomp = reverse . snd . break (/= '\n') . reverse


guessMIMEType :: Lazy.ByteString -> MIMEType
guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack
    where
      magic :: Magic
      magic = unsafePerformIO
              $ do m <- magicOpen [MagicMime]
                   magicLoadDefault m
                   return m


isSafeChar :: Char -> Bool
isSafeChar c
    | c == '/'            = True
    | isReserved c        = False
    | c > ' ' && c <= '~' = True
    | otherwise           = False


mkQueryString :: [(String, String)] -> String
mkQueryString []            = ""
mkQueryString ((k, v) : xs) = encode k ++ "=" ++ encode v ++
                              if xs == [] then
                                  ""
                              else
                                  ';' : mkQueryString(xs)
    where
      encode :: String -> String
      encode = escapeURIString isSafeChar . UTF8.encodeString