{-# 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.Lazy as LS
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.List
import qualified Data.Text as T
import Data.Text.Encoding
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
chomp = reverse . snd . break (/= '\n') . reverse


guessMIMEType ∷ LS.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
    | 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