<commit_before>{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE EmptyDataDecls            #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE ForeignFunctionInterface  #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE TypeSynonymInstances      #-}

------------------------------------------------------------------------------
-- | An internal Snap module containing HTTP types.
--
-- /N.B./ this is an internal interface, please don't write user code that
-- depends on it. Most of these declarations (except for the
-- unsafe/encapsulation-breaking ones) are re-exported from "Snap.Core".
--
module Snap.Internal.Http.Types where

------------------------------------------------------------------------------
import           Blaze.ByteString.Builder
import           Control.Monad (liftM)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import           Data.ByteString.Internal (c2w,w2c)
import qualified Data.ByteString as S
import           Data.CaseInsensitive   (CI)
import qualified Data.CaseInsensitive as CI
import           Data.Int
import qualified Data.IntMap as IM
import           Data.IORef
import           Data.List hiding (take)
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Maybe
import           Data.Monoid
import           Data.Time.Clock
import           Foreign.C.Types
import           Prelude hiding (take)

------------------------------------------------------------------------------
#ifdef PORTABLE
import           Data.Time.Format
import           Data.Time.LocalTime
import           Data.Time.Clock.POSIX
import           System.Locale (defaultTimeLocale)
#else
import           Data.Time.Format ()
import           Foreign
import qualified Data.ByteString.Unsafe as S
import           Foreign.C.String
#endif

------------------------------------------------------------------------------
import           Snap.Iteratee (Enumerator)
import qualified Snap.Iteratee as I
import           Snap.Types.Headers (Headers)
import qualified Snap.Types.Headers as H


#ifndef PORTABLE

------------------------------------------------------------------------------
-- foreign imports from cbits
foreign import ccall unsafe "set_c_locale"
        set_c_locale :: IO ()

foreign import ccall unsafe "c_parse_http_time"
        c_parse_http_time :: CString -> IO CTime

foreign import ccall unsafe "c_format_http_time"
        c_format_http_time :: CTime -> CString -> IO ()

foreign import ccall unsafe "c_format_log_time"
        c_format_log_time :: CTime -> CString -> IO ()

#endif


------------------------------------------------------------------------------
-- | A typeclass for datatypes which contain HTTP headers.
class HasHeaders a where
    -- | Modify the datatype's headers.
    updateHeaders :: (Headers -> Headers) -> a -> a

    -- | Retrieve the headers from a datatype that has headers.
    headers       :: a -> Headers


------------------------------------------------------------------------------
-- | Adds a header key-value-pair to the 'HasHeaders' datatype. If a header
-- with the same name already exists, the new value is appended to the headers
-- list.
addHeader :: (HasHeaders a) => CI ByteString -> ByteString -> a -> a
addHeader k v = updateHeaders $ H.insert k v


------------------------------------------------------------------------------
-- | Sets a header key-value-pair in a 'HasHeaders' datatype. If a header with
-- the same name already exists, it is overwritten with the new value.
setHeader :: (HasHeaders a) => CI ByteString -> ByteString -> a -> a
setHeader k v = updateHeaders $ H.set k v


------------------------------------------------------------------------------
-- | Gets all of the values for a given header.
getHeaders :: (HasHeaders a) => CI ByteString -> a -> Maybe [ByteString]
getHeaders k a = H.lookup k $ headers a


------------------------------------------------------------------------------
-- | Gets a header value out of a 'HasHeaders' datatype. If many headers came
-- in with the same name, they will be catenated together.
getHeader :: (HasHeaders a) => CI ByteString -> a -> Maybe ByteString
getHeader k a = liftM (S.intercalate " ") (H.lookup k $ headers a)


------------------------------------------------------------------------------
-- | Lists all the headers out of a 'HasHeaders' datatype. If many
-- headers came in with the same name, they will be catenated together.
listHeaders :: (HasHeaders a) => a -> [(CI ByteString, ByteString)]
listHeaders = H.toList . headers
<commit_msg>Intercalate header values with ',' (closes #35)<commit_after>{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE EmptyDataDecls            #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE ForeignFunctionInterface  #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE TypeSynonymInstances      #-}

------------------------------------------------------------------------------
-- | An internal Snap module containing HTTP types.
--
-- /N.B./ this is an internal interface, please don't write user code that
-- depends on it. Most of these declarations (except for the
-- unsafe/encapsulation-breaking ones) are re-exported from "Snap.Core".
--
module Snap.Internal.Http.Types where

------------------------------------------------------------------------------
import           Blaze.ByteString.Builder
import           Control.Monad (liftM)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import           Data.ByteString.Internal (c2w,w2c)
import qualified Data.ByteString as S
import           Data.CaseInsensitive   (CI)
import qualified Data.CaseInsensitive as CI
import           Data.Int
import qualified Data.IntMap as IM
import           Data.IORef
import           Data.List hiding (take)
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Maybe
import           Data.Monoid
import           Data.Time.Clock
import           Foreign.C.Types
import           Prelude hiding (take)

------------------------------------------------------------------------------
#ifdef PORTABLE
import           Data.Time.Format
import           Data.Time.LocalTime
import           Data.Time.Clock.POSIX
import           System.Locale (defaultTimeLocale)
#else
import           Data.Time.Format ()
import           Foreign
import qualified Data.ByteString.Unsafe as S
import           Foreign.C.String
#endif

------------------------------------------------------------------------------
import           Snap.Iteratee (Enumerator)
import qualified Snap.Iteratee as I
import           Snap.Types.Headers (Headers)
import qualified Snap.Types.Headers as H


#ifndef PORTABLE

------------------------------------------------------------------------------
-- foreign imports from cbits
foreign import ccall unsafe "set_c_locale"
        set_c_locale :: IO ()

foreign import ccall unsafe "c_parse_http_time"
        c_parse_http_time :: CString -> IO CTime

foreign import ccall unsafe "c_format_http_time"
        c_format_http_time :: CTime -> CString -> IO ()

foreign import ccall unsafe "c_format_log_time"
        c_format_log_time :: CTime -> CString -> IO ()

#endif


------------------------------------------------------------------------------
-- | A typeclass for datatypes which contain HTTP headers.
class HasHeaders a where
    -- | Modify the datatype's headers.
    updateHeaders :: (Headers -> Headers) -> a -> a

    -- | Retrieve the headers from a datatype that has headers.
    headers       :: a -> Headers


------------------------------------------------------------------------------
-- | Adds a header key-value-pair to the 'HasHeaders' datatype. If a header
-- with the same name already exists, the new value is appended to the headers
-- list.
addHeader :: (HasHeaders a) => CI ByteString -> ByteString -> a -> a
addHeader k v = updateHeaders $ H.insert k v


------------------------------------------------------------------------------
-- | Sets a header key-value-pair in a 'HasHeaders' datatype. If a header with
-- the same name already exists, it is overwritten with the new value.
setHeader :: (HasHeaders a) => CI ByteString -> ByteString -> a -> a
setHeader k v = updateHeaders $ H.set k v


------------------------------------------------------------------------------
-- | Gets all of the values for a given header.
getHeaders :: (HasHeaders a) => CI ByteString -> a -> Maybe [ByteString]
getHeaders k a = H.lookup k $ headers a


------------------------------------------------------------------------------
-- | Gets a header value out of a 'HasHeaders' datatype. If many headers came
-- in with the same name, they will be catenated together.
getHeader :: (HasHeaders a) => CI ByteString -> a -> Maybe ByteString
getHeader k a = liftM (S.intercalate ",") (H.lookup k $ headers a)


------------------------------------------------------------------------------
-- | Lists all the headers out of a 'HasHeaders' datatype. If many
-- headers came in with the same name, they will be catenated together.
listHeaders :: (HasHeaders a) => a -> [(CI ByteString, ByteString)]
listHeaders = H.toList . headers

{'fraction_non_alphanumeric': 0.2554690786705932, 'fraction_numerical': 0.001051745898190997, 'mean_word_length': 1.462195753495598, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 53, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '795590', 'n_tokens_mistral': 2333, 'n_tokens_neox': 2266, 'n_words': 825}