<commit_before>{-# LANGUAGE CPP, RankNTypes, MagicHash, BangPatterns #-}

-- CPP C style pre-precessing, the #if defined lines
-- RankNTypes forall r. statement
-- MagicHash the (# unboxing #), also needs GHC.primitives

module Data.Binary.Get (

    -- * The Get type
      Get
    , Result(..)
    , runGet
    , runGetPush

    -- * Parsing
    -- , skip

    -- * Utility
    -- , bytesRead
    -- , remaining
    -- , isEmpty

    -- * Parsing particular types
    , getWord8

    -- ** ByteStrings
    , getByteString
    , getLazyByteString
    -- , getLazyByteStringNul
    -- , getRemainingLazyByteString

    -- ** Big-endian reads
    , getWord16be
    , getWord32be
    , getWord64be

    -- ** Little-endian reads
    , getWord16le
    , getWord32le
    , getWord64le

    -- ** Host-endian, unaligned reads
    , getWordhost
    , getWord16host
    , getWord32host
    , getWord64host

    ) where

import Foreign
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as L

import Control.Applicative

#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
-- needed for (# unboxing #) with magic hash
import GHC.Base
import GHC.Word
import GHC.Int
#endif

newtype S = S B.ByteString deriving Show

data Result a = Fail S String
              | Partial (Maybe B.ByteString -> Result a)
              | Done S a

-- unrolled codensity/state monad
newtype Get a = C { runCont :: forall r. S -> (S -> a -> Result r) -> Result r }

instance Monad Get where
  return = returnG
  (>>=) = bindG

returnG :: a -> Get a
returnG a = C $ \s k -> k s a
{-# INLINE returnG #-}

bindG :: Get a -> (a -> Get b) -> Get b
bindG (C c) f = C $ \s k -> c s (\s' a -> runCont (f a) s' k)
{-# INLINE bindG #-}

apG :: Get (a -> b) -> Get a -> Get b
apG d e = do
  b <- d
  a <- e
  return (b a)
{-# INLINE apG #-}

fmapG :: (a -> b) -> Get a -> Get b
fmapG f m = C $ \s0 k -> runCont m s0 (\s a -> k s (f a))
{-# INLINE fmapG #-}

instance Applicative Get where
  pure = returnG
  (<*>) = apG

instance Functor Get where
  fmap = fmapG

instance Functor Result where
  fmap f (Done s a) = Done s (f a)
  fmap f (Partial c) = Partial (\bs -> fmap f (c bs))
  fmap f (Fail s msg) = Fail s msg

instance (Show a) => Show (Result a) where
  show (Fail _ msg) = "Fail: " ++ msg
  show (Partial _) = "Partial _"
  show (Done _ a) = "Done: " ++ show a

runGetPush :: Get a -> Result a
runGetPush g = runCont g (S B.empty) (\s a -> Done s a)

runGet :: Get a -> L.ByteString -> a
runGet g bs = feed (runGetPush g) chunks
  where
  chunks = L.toChunks bs
  feed (Done _ r) _ = r
  feed r@(Partial c) (x:xs) = feed (c (Just x)) xs 
  feed r@(Partial c) [] = feed (c Nothing) []
  feed (Fail _ msg) _ = error msg
 
-- | Need more data, at least @n@ bytes.
needMore :: Get ()
needMore = C $ \st0@(S s) k -> 
  Partial $ \sm -> 
    case sm of
      Nothing -> Fail st0 "not enough bytes"
      Just s' -> k (S (B.append s s')) ()

getS :: Get B.ByteString
getS = C $ \st0@(S s) k -> k st0 s
{-# INLINE getS #-}

setS :: B.ByteString -> Get ()
setS s = C $ \_ k -> k (S s) ()
{-# INLINE setS #-}

------------------------------------------------------------------------
-- ByteStrings
--

getByteString :: Int -> Get B.ByteString
getByteString n = B.take n <$> readN n

remainingInCurrentChunk :: Get Int
remainingInCurrentChunk = C $ \(S s) k -> k (S s) (B.length s)

getLazyByteString :: Int64 -> Get L.ByteString
getLazyByteString n0 =
  let loop n = do
        left <- remainingInCurrentChunk
        if fromIntegral left >= n
          then fmap (:[]) (getByteString (fromIntegral n))
          else do now <- getByteString left<commit_msg>Remove INLINE, no performance enhancement with ghc 6.12.1<commit_after>{-# LANGUAGE CPP, RankNTypes, MagicHash, BangPatterns #-}

-- CPP C style pre-precessing, the #if defined lines
-- RankNTypes forall r. statement
-- MagicHash the (# unboxing #), also needs GHC.primitives

module Data.Binary.Get (

    -- * The Get type
      Get
    , Result(..)
    , runGet
    , runGetPush

    -- * Parsing
    -- , skip

    -- * Utility
    -- , bytesRead
    -- , remaining
    -- , isEmpty

    -- * Parsing particular types
    , getWord8

    -- ** ByteStrings
    , getByteString
    , getLazyByteString
    -- , getLazyByteStringNul
    -- , getRemainingLazyByteString

    -- ** Big-endian reads
    , getWord16be
    , getWord32be
    , getWord64be

    -- ** Little-endian reads
    , getWord16le
    , getWord32le
    , getWord64le

    -- ** Host-endian, unaligned reads
    , getWordhost
    , getWord16host
    , getWord32host
    , getWord64host

    ) where

import Foreign
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as L

import Control.Applicative

#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
-- needed for (# unboxing #) with magic hash
import GHC.Base
import GHC.Word
import GHC.Int
#endif

newtype S = S B.ByteString deriving Show

data Result a = Fail S String
              | Partial (Maybe B.ByteString -> Result a)
              | Done S a

-- unrolled codensity/state monad
newtype Get a = C { runCont :: forall r. S -> (S -> a -> Result r) -> Result r }

instance Monad Get where
  return = returnG
  (>>=) = bindG

returnG :: a -> Get a
returnG a = C $ \s k -> k s a

bindG :: Get a -> (a -> Get b) -> Get b
bindG (C c) f = C $ \s k -> c s (\s' a -> runCont (f a) s' k)

apG :: Get (a -> b) -> Get a -> Get b
apG d e = do
  b <- d
  a <- e
  return (b a)

fmapG :: (a -> b) -> Get a -> Get b
fmapG f m = C $ \s0 k -> runCont m s0 (\s a -> k s (f a))

instance Applicative Get where
  pure = returnG
  (<*>) = apG

instance Functor Get where
  fmap = fmapG

instance Functor Result where
  fmap f (Done s a) = Done s (f a)
  fmap f (Partial c) = Partial (\bs -> fmap f (c bs))
  fmap f (Fail s msg) = Fail s msg

instance (Show a) => Show (Result a) where
  show (Fail _ msg) = "Fail: " ++ msg
  show (Partial _) = "Partial _"
  show (Done _ a) = "Done: " ++ show a

runGetPush :: Get a -> Result a
runGetPush g = runCont g (S B.empty) (\s a -> Done s a)

runGet :: Get a -> L.ByteString -> a
runGet g bs = feed (runGetPush g) chunks
  where
  chunks = L.toChunks bs
  feed (Done _ r) _ = r
  feed r@(Partial c) (x:xs) = feed (c (Just x)) xs 
  feed r@(Partial c) [] = feed (c Nothing) []
  feed (Fail _ msg) _ = error msg
 
-- | Need more data, at least @n@ bytes.
needMore :: Get ()
needMore = C $ \st0@(S s) k -> 
  Partial $ \sm -> 
    case sm of
      Nothing -> Fail st0 "not enough bytes"
      Just s' -> k (S (B.append s s')) ()

getS :: Get B.ByteString
getS = C $ \st0@(S s) k -> k st0 s

setS :: B.ByteString -> Get ()
setS s = C $ \_ k -> k (S s) ()

------------------------------------------------------------------------
-- ByteStrings
--

getByteString :: Int -> Get B.ByteString
getByteString n = B.take n <$> readN n

remainingInCurrentChunk :: Get Int
remainingInCurrentChunk = C $ \(S s) k -> k (S s) (B.length s)

getLazyByteString :: Int64 -> Get L.ByteString
getLazyByteString n0 =
  let loop n = do
        left <- remainingInCurrentChunk
        if fromIntegral left >= n
          then fmap (:[]) (getByteString (fromIntegral n))
          else do now <- getByteString left
{'fraction_non_alphanumeric': 0.14847338557146716, 'fraction_numerical': 0.00810591731964334, 'mean_word_length': 2.2075389948006934, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 85, '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': '4974337', 'n_tokens_mistral': 2678, 'n_tokens_neox': 2601, 'n_words': 920}