Rakka/Utils.hs

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