← Back to branch summary

~ubuntu-branches/ubuntu/saucy/haskell-wai-extra/saucy-proposed

« back to all changes in this revision

Viewing changes to Network/Wai/Middleware/Jsonp.hs

  • Committer: Package Import Robot
  • Author(s): Clint Adams
  • Date: 2012-03-09 14:12:00 UTC
  • mfrom: (2.1.6 sid)
  • Revision ID: package-import@ubuntu.com-20120309141200-pwnlh5b9fme9ps47
Tags: 1.1.0.1-2
http://bugs.debian.org/663242
Add missing build dependencies on ansi-terminal.  closes: #663242.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Network/Wai/Middleware/Jsonp.hs
18
18
import Network.Wai
19
19
import Data.ByteString (ByteString)
20
20
import qualified Data.ByteString.Char8 as B8
21
 
import Data.Enumerator (($$), enumList, Step (..), Enumerator, Iteratee, Enumeratee, joinI, checkDone, continue, Stream (..), (>>==))
22
 
import Blaze.ByteString.Builder (copyByteString, Builder)
 
21
import Blaze.ByteString.Builder (copyByteString)
23
22
import Blaze.ByteString.Builder.Char8 (fromChar)
24
23
import Data.Monoid (mappend)
25
24
import Control.Monad (join)
26
25
import Data.Maybe (fromMaybe)
27
26
import qualified Data.ByteString as S
 
27
import qualified Data.Conduit as C
 
28
import qualified Data.Conduit.List as CL
28
29
 
29
30
-- | Wrap json responses in a jsonp callback.
30
31
--
54
55
        Nothing -> return res
55
56
        Just c -> go c res
56
57
  where
57
 
    go c r@(ResponseFile _ hs _ _) = go' c r hs
58
58
    go c r@(ResponseBuilder s hs b) =
59
59
        case checkJSON hs of
60
60
            Nothing -> return r
63
63
                `mappend` fromChar '('
64
64
                `mappend` b
65
65
                `mappend` fromChar ')'
66
 
    go c (ResponseEnumerator e) = addCallback c e
67
 
    go' c r hs =
 
66
    go c r =
68
67
        case checkJSON hs of
69
 
            Just _ -> addCallback c $ responseEnumerator r
 
68
            Just hs' -> addCallback c s hs' b
70
69
            Nothing -> return r
 
70
      where
 
71
        (s, hs, b) = responseSource r
 
72
 
71
73
    checkJSON hs =
72
74
        case lookup "Content-Type" hs of
73
75
            Just x
74
 
                | B8.pack "application/json" `S.isPrefixOf` x -> Just $ fixHeaders hs
 
76
                | B8.pack "application/json" `S.isPrefixOf` x ->
 
77
                    Just $ fixHeaders hs
75
78
            _ -> Nothing
76
79
    fixHeaders = changeVal "Content-Type" "text/javascript"
77
 
    addCallback :: B8.ByteString -> (forall a. ResponseEnumerator a)
78
 
                -> Iteratee B8.ByteString IO Response
79
 
    addCallback cb e =
80
 
        return $ ResponseEnumerator $ helper
81
 
      where
82
 
        helper f =
83
 
            e helper'
84
 
          where
85
 
            helper' s hs =
86
 
                case checkJSON hs of
87
 
                    Just hs' -> wrap $$ f s hs'
88
 
                    Nothing -> f s hs
89
 
        wrap :: Step Builder IO b -> Iteratee Builder IO b
90
 
        wrap step = joinI $ after (enumList 1 [fromChar ')'])
91
 
                 $$ enumList 1 [copyByteString cb, fromChar '('] step
92
 
        after :: Enumerator Builder IO b -> Enumeratee Builder Builder IO b
93
 
        after enum =
94
 
            loop
95
 
          where
96
 
            loop = checkDone $ continue . step
97
 
            step k EOF = enum (Continue k) >>== return
98
 
            step k s = k s >>== loop
 
80
 
 
81
    addCallback cb s hs b =
 
82
        return $ ResponseSource s hs $
 
83
            CL.sourceList [C.Chunk $ copyByteString cb `mappend` fromChar '(']
 
84
            `mappend` b
 
85
            `mappend` CL.sourceList [C.Chunk $ fromChar ')']
99
86
 
100
87
changeVal :: Eq a
101
88
          => a