Rakka/Utils.hs

   1 module Rakka.Utils
   2     ( yesOrNo
   3     , parseYesOrNo
   4     , maybeA
   5     , deleteIfEmpty
   6     , chomp
   7     , guessMIMEType
   8     )
   9     where
  10
  11 import           Control.Arrow
  12 import           Control.Arrow.ArrowList
  13 import qualified Data.ByteString.Lazy as Lazy (ByteString)
  14 import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
  15 import           Magic
  16 import           Network.HTTP.Lucu
  17 import           System.IO.Unsafe
  18
  19
  20 yesOrNo :: Bool -> String
  21 yesOrNo True  = "yes"
  22 yesOrNo False = "no"
  23
  24
  25 parseYesOrNo :: ArrowChoice a => a String Bool
  26 parseYesOrNo
  27     = proc str -> do case str of
  28                        "yes" -> returnA -< True
  29                        "no"  -> returnA -< False
  30                        _     -> returnA -< error ("Expected yes or no: " ++ str)
  31
  32
  33 maybeA :: (ArrowList a, ArrowChoice a) => a b c -> a b (Maybe c)
  34 maybeA a = listA a
  35            >>>
  36            proc xs -> case xs of
  37                         []    -> returnA -< Nothing
  38                         (x:_) -> returnA -< Just x
  39
  40
  41 deleteIfEmpty :: (ArrowList a, ArrowChoice a) => a String String
  42 deleteIfEmpty
  43     = proc str -> do case str of
  44                        "" -> none    -< ()
  45                        _  -> returnA -< str
  46
  47
  48 chomp :: String -> String
  49 chomp = reverse . snd . break (/= '\n') . reverse
  50
  51
  52 guessMIMEType :: Lazy.ByteString -> MIMEType
  53 guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack
  54     where
  55       magic :: Magic
  56       magic = unsafePerformIO
  57               $ do m <- magicOpen [MagicMime]
  58                    magicLoadDefault m
  59                    return m