Permalink
Browse files

merge original snap master

  • Loading branch information...
2 parents a3197be + 697e20a commit b20425bbb0edb2376710461fbde228a7ebeac53f cvb committed Nov 18, 2012
View
@@ -1,5 +1,5 @@
name: snap-core
-version: 0.9.1
+version: 0.9.2.2
synopsis: Snap: A Haskell Web Framework (core interfaces and types)
description:
@@ -93,6 +93,7 @@ Library
if flag(portable) || os(windows)
cpp-options: -DPORTABLE
+ build-depends: old-locale >= 1 && <2
else
c-sources: cbits/timefuncs.c
include-dirs: cbits
@@ -128,36 +129,29 @@ Library
build-depends:
- attoparsec >= 0.10 && < 0.11,
- attoparsec-enumerator >= 0.3 && <0.4,
- base >= 4 && < 5,
- base16-bytestring <= 0.2,
- blaze-builder >= 0.2.1.4 && <0.4,
- blaze-builder-enumerator >= 0.2 && <0.3,
- bytestring,
- bytestring-nums,
- case-insensitive >= 0.3 && < 0.5,
- containers,
- deepseq >= 1.1 && <1.4,
- directory,
- dlist >= 0.5 && < 0.6,
- enumerator >= 0.4.15 && < 0.5,
- filepath,
- HUnit >= 1.2 && < 2,
- MonadCatchIO-transformers >= 0.2.1 && < 0.4,
- mtl >= 2.0 && < 2.2,
- mwc-random >= 0.10 && <0.13,
- old-locale,
- old-time,
- regex-posix <= 0.95.2,
- text >= 0.11 && <0.12,
- time >= 1.0 && < 1.5,
- transformers >= 0.2 && < 0.4,
- unix-compat >= 0.2 && <0.4,
- unordered-containers >= 0.1.4.3 && <0.3,
- vector >= 0.6 && <0.10,
- zlib-enum >= 0.2.1 && <0.3,
- system-filepath == 0.4.*
+ attoparsec >= 0.10 && < 0.11,
+ attoparsec-enumerator >= 0.3 && < 0.4,
+ base >= 4 && < 5,
+ blaze-builder >= 0.2.1.4 && < 0.4,
+ blaze-builder-enumerator >= 0.2 && < 0.3,
+ bytestring >= 0.9 && < 0.11,
+ case-insensitive >= 0.3 && < 0.5,
+ containers >= 0.3 && < 1.0,
+ deepseq >= 1.1 && < 1.4,
+ directory >= 1 && < 2,
+ enumerator >= 0.4.15 && < 0.5,
+ filepath >= 1.1 && < 2.0,
+ HUnit >= 1.2 && < 2,
+ MonadCatchIO-transformers >= 0.2.1 && < 0.4,
+ mtl >= 2.0 && < 2.2,
+ random >= 1 && < 2,
+ regex-posix >= 0.95 && < 1,
+ text >= 0.11 && < 0.12,
+ time >= 1.0 && < 1.5,
+ unix-compat >= 0.2 && < 0.5,
+ unordered-containers >= 0.1.4.3 && < 0.3,
+ vector >= 0.6 && < 0.11,
+ zlib-enum >= 0.2.1 && < 0.3
extensions:
BangPatterns,
@@ -1,5 +1,6 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
module Snap.Internal.Instances where
@@ -15,7 +16,9 @@ import Control.Monad.State.Strict
import qualified Control.Monad.State.Lazy as LState
import Control.Monad.Writer.Strict hiding (pass)
import qualified Control.Monad.Writer.Lazy as LWriter
+#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
+#endif
------------------------------------------------------------------------------
import Snap.Internal.Types
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -10,18 +11,14 @@ import Control.Applicative
import Control.Arrow (first, second)
import Control.Monad
import Data.Attoparsec.Char8
-import Data.Attoparsec.Types (IResult(..))
import Data.Bits
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Data.ByteString.Nums.Careless.Hex as Cvt
import qualified Data.CaseInsensitive as CI
import Data.CaseInsensitive (CI)
import Data.Char hiding (isDigit, isSpace)
-import Data.DList (DList)
-import qualified Data.DList as DL
import Data.Int
import Data.List (intersperse)
import Data.Map (Map)
@@ -274,10 +271,12 @@ parseToCompletion p s = toResult $ finish r
------------------------------------------------------------------------------
+type DList a = [a] -> [a]
+
pUrlEscaped :: Parser ByteString
pUrlEscaped = do
- sq <- nextChunk DL.empty
- return $! S.concat $ DL.toList sq
+ sq <- nextChunk id
+ return $! S.concat $ sq []
where
--------------------------------------------------------------------------
@@ -296,21 +295,21 @@ pUrlEscaped = do
when (S.length hx /= 2 || (not $ S.all isHexDigit hx)) $
fail "bad hex in url"
- let code = w2c ((Cvt.hex hx) :: Word8)
- nextChunk $ DL.snoc l (S.singleton code)
+ let code = w2c ((unsafeFromHex hx) :: Word8)
+ nextChunk $ l . ((S.singleton code) :)
--------------------------------------------------------------------------
unEncoded :: Char -> DList ByteString -> Parser (DList ByteString)
unEncoded !c !l' = do
- let l = DL.snoc l' (S.singleton c)
+ let l = l' . ((S.singleton c) :)
bs <- takeTill (flip elem "%+")
if S.null bs
then nextChunk l
- else nextChunk $ DL.snoc l bs
+ else nextChunk $ l . (bs :)
--------------------------------------------------------------------------
plusSpace :: DList ByteString -> Parser (DList ByteString)
- plusSpace l = nextChunk (DL.snoc l (S.singleton ' '))
+ plusSpace l = nextChunk (l . ((S.singleton ' ') :))
------------------------------------------------------------------------------
@@ -464,3 +463,29 @@ parseCookie = parseToCompletion pCookies
------------------------------------------------------------------------------
strictize :: L.ByteString -> ByteString
strictize = S.concat . L.toChunks
+
+------------------------------------------------------------------------------
+unsafeFromHex :: (Enum a, Num a, Bits a) => ByteString -> a
+unsafeFromHex = S.foldl' f 0
+ where
+#if MIN_VERSION_base(4,5,0)
+ sl = unsafeShiftL
+#else
+ sl = shiftL
+#endif
+
+ f !cnt !i = sl cnt 4 .|. nybble i
+
+ nybble c | c >= '0' && c <= '9' = toEnum $! fromEnum c - fromEnum '0'
+ | c >= 'a' && c <= 'f' = toEnum $! 10 + fromEnum c - fromEnum 'a'
+ | c >= 'A' && c <= 'F' = toEnum $! 10 + fromEnum c - fromEnum 'A'
+ | otherwise = error $ "bad hex digit: " ++ show c
+{-# INLINE unsafeFromHex #-}
+
+
+------------------------------------------------------------------------------
+unsafeFromInt :: (Enum a, Num a, Bits a) => ByteString -> a
+unsafeFromInt = S.foldl' f 0
+ where
+ f !cnt !i = cnt * 10 + toEnum (digitToInt i)
+{-# INLINE unsafeFromInt #-}
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
@@ -37,16 +38,18 @@ import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char8
import Control.Monad.State hiding (get, put)
import qualified Control.Monad.State as State
-import qualified Data.ByteString.Base16 as B16
+import Data.Bits
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString as S8
import Data.CaseInsensitive (CI)
import Data.IORef
import qualified Data.Map as Map
import Data.Monoid
import Data.Word
+import qualified Data.Vector as V
import System.PosixCompat.Time
-import System.Random.MWC
+import System.Random
------------------------------------------------------------------------------
import Snap.Internal.Http.Types hiding (addHeader,
setContentType,
@@ -227,10 +230,30 @@ setRequestType (UrlEncodedPostRequest fp) = do
------------------------------------------------------------------------------
makeBoundary :: MonadIO m => m ByteString
makeBoundary = do
- xs <- liftIO $ withSystemRandom $ \rng ->
- replicateM 16 ((uniform rng) :: IO Word8)
+ xs <- liftIO $ replicateM 16 randomWord8
let x = S.pack $ map (toEnum . fromEnum) xs
- return $ S.concat [ "snap-boundary-", B16.encode x ]
+ return $ S.concat [ "snap-boundary-", encode x ]
+
+ where
+ randomWord8 :: IO Word8
+ randomWord8 = liftM (\c -> toEnum $ c .&. 0xff) randomIO
+
+ table = V.fromList [ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'
+ , 'a', 'b', 'c', 'd', 'e', 'f' ]
+
+ encode = toByteString . S8.foldl' f mempty
+
+#if MIN_VERSION_base(4,5,0)
+ shR = unsafeShiftR
+#else
+ shR = shiftR
+#endif
+
+ f m c = let low = c .&. 0xf
+ hi = (c .&. 0xf0) `shR` 4
+ k = \i -> fromWord8 $! toEnum $! fromEnum $!
+ V.unsafeIndex table (fromEnum i)
+ in m `mappend` k hi `mappend` k low
------------------------------------------------------------------------------
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -31,7 +32,11 @@ import Data.Time
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Typeable
+#if MIN_VERSION_base(4,6,0)
+import Prelude hiding (take)
+#else
import Prelude hiding (catch, take)
+#endif
import System.PosixCompat.Files hiding (setFileSize)
import System.Posix.Types (FileOffset)
------------------------------------------------------------------------------
@@ -260,7 +265,11 @@ instance MonadSnap Snap where
-- | The Typeable instance is here so Snap can be dynamically executed with
-- Hint.
snapTyCon :: TyCon
+#if MIN_VERSION_base(4,4,0)
+snapTyCon = mkTyCon3 "snap-core" "Snap.Core" "Snap"
+#else
snapTyCon = mkTyCon "Snap.Core.Snap"
+#endif
{-# NOINLINE snapTyCon #-}
instance Typeable1 Snap where
View
@@ -1,9 +1,9 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -127,7 +127,11 @@ import Data.Typeable
import Foreign hiding (peek)
import Foreign.C.Types
import GHC.ForeignPtr
+#if MIN_VERSION_base(4,6,0)
+import Prelude hiding (drop, head, take)
+#else
import Prelude hiding (catch, drop, head, take)
+#endif
import System.IO
#ifndef PORTABLE
@@ -44,7 +44,11 @@ import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
+#if MIN_VERSION_base(4,6,0)
+import Prelude hiding (show, Show)
+#else
import Prelude hiding (catch, show, Show)
+#endif
import qualified Prelude
import System.Directory
import System.FilePath
@@ -80,7 +80,6 @@ import qualified Data.ByteString.Char8 as S
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Internal (c2w)
import qualified Data.CaseInsensitive as CI
-import qualified Data.DList as D
import Data.Enumerator.Binary (iterHandle)
import Data.IORef
import Data.Int
@@ -91,7 +90,11 @@ import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Text.Encoding as TE
import Data.Typeable
+#if MIN_VERSION_base(4,6,0)
+import Prelude hiding (getLine, takeWhile)
+#else
import Prelude hiding (catch, getLine, takeWhile)
+#endif
import System.Directory
import System.IO hiding (isEOF)
------------------------------------------------------------------------------
@@ -796,7 +799,7 @@ processPart st = {-# SCC "pPart/outer" #-}
-- list of the resulting values.
processParts :: Iteratee ByteString IO a
-> Iteratee MatchInfo IO [a]
-processParts partIter = iterateeDebugWrapper "processParts" $ go D.empty
+processParts partIter = iterateeDebugWrapper "processParts" $ go id
where
iter = {-# SCC "processParts/iter" #-} do
isLast <- bParser
@@ -811,7 +814,7 @@ processParts partIter = iterateeDebugWrapper "processParts" $ go D.empty
b <- isEOF
if b
- then return $! D.toList soFar
+ then return $ soFar []
else do
-- processPart $$ iter
-- :: Iteratee MatchInfo m (Step ByteString m a)
@@ -821,8 +824,8 @@ processParts partIter = iterateeDebugWrapper "processParts" $ go D.empty
output <- lift $ run_ $ returnI innerStep
case output of
- Just x -> go (D.append soFar $ D.singleton x)
- Nothing -> return $! D.toList soFar
+ Just x -> go (soFar . (x:))
+ Nothing -> return $ soFar []
bParser = iterateeDebugWrapper "boundary debugger" $
iterParser $ pBoundaryEnd
Oops, something went wrong.

0 comments on commit b20425b

Please sign in to comment.