bytestring-nums-0.3.5/0000755000000000000000000000000011650716336013067 5ustar0000000000000000bytestring-nums-0.3.5/Setup.hs0000644000000000000000000000011111650716336014514 0ustar0000000000000000import Distribution.Simple main = defaultMain bytestring-nums-0.3.5/README0000644000000000000000000000000511650716336013742 0ustar0000000000000000 bytestring-nums-0.3.5/SPOJEugeneKirpichov.hs0000644000000000000000000000220411650716336017204 0ustar0000000000000000 module Main where import qualified Data.ByteString.Lazy as B import Data.ByteString.Nums.Careless -- from bytestring-nums package bint :: B.ByteString -> Int bint = int main = do line : rest <- B.split 10 `fmap` B.getContents let [n, k] = map int . B.split 32 $ line putStrLn . show . length . tail . filter ((==0).(`mod`k).bint) $ rest {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ---------- Forwarded message ---------- From: Eugene Kirpichov Date: 2009/08/30 Subject: Re: [Haskell-cafe] Slow IO? To: Steve Cc: haskell-cafe@haskell.org module Main where import qualified Data.ByteString.Lazy as B import Data.ByteString.Nums.Careless -- from bytestring-nums package bint :: B.ByteString -> Int bint = int main = do line : rest <- B.split 10 `fmap` B.getContents let [n, k] = map int . B.split 32 $ line putStrLn . show . length . tail . filter ((==0).(`mod`k).bint) $ rest This does a 100MB file in 2.7s (probably because the file is cached by the filesystem). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} bytestring-nums-0.3.5/LICENSE0000644000000000000000000000262711650716336014103 0ustar0000000000000000 ©2009 Jason Dusek. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: . Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. . Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. . Names of the contributors to this software may not be used to endorse or promote products derived from this software without specific prior written permission. This software is provided by the contributors "as is" and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the contributors be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. bytestring-nums-0.3.5/bytestring-nums.cabal0000644000000000000000000000367011650716336017233 0ustar0000000000000000name : bytestring-nums version : 0.3.5 category : Text license : BSD3 license-file : LICENSE author : Jason Dusek maintainer : jason.dusek@gmail.com stability : experimental homepage : http://github.com/solidsnack/bytestring-nums synopsis : Parse numeric literals from ByteStrings. description : Parse numeric literals from ByteStrings. cabal-version : >= 1.6 build-type : Simple extra-source-files : README source-repository head type : git location : http://github.com/solidsnack/bytestring-nums.git flag cli description : Enable command line tool. default : False library build-depends : base >= 3 && < 5 , containers , bytestring >= 0.9 exposed-modules : Data.ByteString.Nums.Careless Data.ByteString.Nums.Careless.Hex Data.ByteString.Nums.Careless.Int Data.ByteString.Nums.Careless.Float extensions : MultiParamTypeClasses TypeSynonymInstances BangPatterns ghc-options : -O2 -Wall -funbox-strict-fields executable spoj-eugene main-is : SPOJEugeneKirpichov.hs if flag(cli) buildable : True else buildable : False extensions : MultiParamTypeClasses TypeSynonymInstances BangPatterns ghc-options : -O2 -Wall -funbox-strict-fields bytestring-nums-0.3.5/Data/0000755000000000000000000000000011650716336013740 5ustar0000000000000000bytestring-nums-0.3.5/Data/ByteString/0000755000000000000000000000000011650716336016032 5ustar0000000000000000bytestring-nums-0.3.5/Data/ByteString/Nums/0000755000000000000000000000000011650716336016754 5ustar0000000000000000bytestring-nums-0.3.5/Data/ByteString/Nums/Careless.hs0000644000000000000000000000072711650716336021057 0ustar0000000000000000 {-| Careless conversion of @ByteString@s to numbers, ignoring bytes that aren't hex or decimal digits. -} module Data.ByteString.Nums.Careless ( module Data.ByteString.Nums.Careless.Int , module Data.ByteString.Nums.Careless.Hex , module Data.ByteString.Nums.Careless.Float ) where import Data.ByteString.Nums.Careless.Int (Intable(..)) import Data.ByteString.Nums.Careless.Hex (Hexable(..)) import Data.ByteString.Nums.Careless.Float (Floatable(..)) bytestring-nums-0.3.5/Data/ByteString/Nums/Careless/0000755000000000000000000000000011650716336020515 5ustar0000000000000000bytestring-nums-0.3.5/Data/ByteString/Nums/Careless/Hex.hs0000644000000000000000000000717311650716336021605 0ustar0000000000000000 {-# LANGUAGE MultiParamTypeClasses , TypeSynonymInstances , FlexibleInstances #-} module Data.ByteString.Nums.Careless.Hex where import Prelude hiding (head, tail, drop) import Data.Word import Data.Int import Data.Ratio import Data.ByteString hiding (head, pack) import Data.ByteString.Char8 hiding (foldl') import Data.ByteString.Internal import qualified Data.ByteString.Lazy.Char8 as Lazy import qualified Data.ByteString.Lazy.Internal as Lazy {-| Types that can be read from hexadecimal strings. Characters that are not hexadecimal digits are skipped over. One pleasant consequence of this is that a leading @0x@ is simply ignored. -} class (Num n) => Hexable b n where hex :: b -> n instance Hexable ByteString Word8 where hex = strict_hex instance Hexable ByteString Word16 where hex = strict_hex instance Hexable ByteString Word32 where hex = strict_hex instance Hexable ByteString Word64 where hex = strict_hex instance Hexable ByteString Word where hex = strict_hex instance Hexable ByteString Int8 where hex = strict_hex instance Hexable ByteString Int16 where hex = strict_hex instance Hexable ByteString Int32 where hex = strict_hex instance Hexable ByteString Int64 where hex = strict_hex instance Hexable ByteString Int where hex = strict_hex instance Hexable ByteString Float where hex = strict_hex instance Hexable ByteString Double where hex = strict_hex instance Hexable ByteString Rational where hex = strict_hex instance Hexable ByteString Integer where hex = strict_hex instance Hexable Lazy.ByteString Word8 where hex = lazy_hex instance Hexable Lazy.ByteString Word16 where hex = lazy_hex instance Hexable Lazy.ByteString Word32 where hex = lazy_hex instance Hexable Lazy.ByteString Word64 where hex = lazy_hex instance Hexable Lazy.ByteString Word where hex = lazy_hex instance Hexable Lazy.ByteString Int8 where hex = lazy_hex instance Hexable Lazy.ByteString Int16 where hex = lazy_hex instance Hexable Lazy.ByteString Int32 where hex = lazy_hex instance Hexable Lazy.ByteString Int64 where hex = lazy_hex instance Hexable Lazy.ByteString Int where hex = lazy_hex instance Hexable Lazy.ByteString Float where hex = lazy_hex instance Hexable Lazy.ByteString Double where hex = lazy_hex instance Hexable Lazy.ByteString Rational where hex = lazy_hex instance Hexable Lazy.ByteString Integer where hex = lazy_hex hexalize :: (Num n) => n -> Word8 -> n hexalize acc byte | between 'a' 'f' = place_up (byte + 0x0a - c2w 'a') | between 'A' 'F' = place_up (byte + 0x0a - c2w 'A') | between '0' '9' = place_up (byte - c2w '0') | otherwise = acc where between a z = byte >= c2w a && byte <= c2w z place_up b = (0x10 * acc) + fromIntegral b strict_hex bytes = foldl' hexalize 0 bytes lazy_hex bytes = Lazy.foldlChunks (foldl' hexalize) 0 bytes bytestring-nums-0.3.5/Data/ByteString/Nums/Careless/Int.hs0000644000000000000000000001017111650716336021603 0ustar0000000000000000 {-# LANGUAGE MultiParamTypeClasses , TypeSynonymInstances , FlexibleInstances #-} module Data.ByteString.Nums.Careless.Int where import Prelude hiding (head, tail, null) import Data.Word import Data.Int import Data.Ratio import Data.ByteString hiding (head, pack) import Data.ByteString.Internal import Data.ByteString.Char8 hiding (foldl') import qualified Data.ByteString.Lazy.Char8 as Lazy import qualified Data.ByteString.Lazy.Internal as Lazy {-| Types that can be read from integer strings. Parses only decimal digits. Signed types can be read from strings that begin with a plus or minus; unsigned types are read from strings consisting solely of decimal digits. -} class (Num n) => Intable b n where int :: b -> n instance Intable ByteString Word8 where int = strict_unsigned instance Intable ByteString Word16 where int = strict_unsigned instance Intable ByteString Word32 where int = strict_unsigned instance Intable ByteString Word64 where int = strict_unsigned instance Intable ByteString Word where int = strict_unsigned instance Intable ByteString Int8 where int = strict_signed instance Intable ByteString Int16 where int = strict_signed instance Intable ByteString Int32 where int = strict_signed instance Intable ByteString Int64 where int = strict_signed instance Intable ByteString Int where int = strict_signed instance Intable ByteString Float where int = strict_signed instance Intable ByteString Double where int = strict_signed instance Intable ByteString Rational where int = strict_signed instance Intable ByteString Integer where int = strict_signed instance Intable Lazy.ByteString Word8 where int = lazy_unsigned instance Intable Lazy.ByteString Word16 where int = lazy_unsigned instance Intable Lazy.ByteString Word32 where int = lazy_unsigned instance Intable Lazy.ByteString Word64 where int = lazy_unsigned instance Intable Lazy.ByteString Word where int = lazy_unsigned instance Intable Lazy.ByteString Int8 where int = lazy_signed instance Intable Lazy.ByteString Int16 where int = lazy_signed instance Intable Lazy.ByteString Int32 where int = lazy_signed instance Intable Lazy.ByteString Int64 where int = lazy_signed instance Intable Lazy.ByteString Int where int = lazy_signed instance Intable Lazy.ByteString Float where int = lazy_signed instance Intable Lazy.ByteString Double where int = lazy_signed instance Intable Lazy.ByteString Rational where int = lazy_signed instance Intable Lazy.ByteString Integer where int = lazy_signed lazy_unsigned :: (Num n) => Lazy.ByteString -> n lazy_unsigned = Lazy.foldlChunks (foldl' positive) 0 lazy_signed bytes | Lazy.null bytes = 0 | Lazy.head bytes == '-' = fold negative 0 (Lazy.tail bytes) | Lazy.head bytes == '+' = fold positive 0 (Lazy.tail bytes) | otherwise = fold positive 0 bytes where fold = Lazy.foldlChunks . foldl' strict_unsigned :: (Num n) => ByteString -> n strict_unsigned = foldl' positive 0 strict_signed bytes | null bytes = 0 | head bytes == '-' = foldl' negative 0 (tail bytes) | head bytes == '+' = foldl' positive 0 (tail bytes) | otherwise = foldl' positive 0 bytes positive acc byte = (acc * 10) + fromIntegral (byte - c2w '0') negative acc byte = (acc * 10) - fromIntegral (byte - c2w '0') bytestring-nums-0.3.5/Data/ByteString/Nums/Careless/Float.hs0000644000000000000000000000542011650716336022117 0ustar0000000000000000 {-# LANGUAGE MultiParamTypeClasses , TypeSynonymInstances , FlexibleInstances #-} module Data.ByteString.Nums.Careless.Float where import Data.Char import Prelude hiding (break, length, null, drop, tail, head) import Data.ByteString hiding (head, break, pack) import Data.ByteString.Char8 hiding (inits, elem, last, foldl') import qualified Data.ByteString.Lazy.Internal as Lazy import qualified Data.ByteString.Lazy.Char8 as Lazy import Data.ByteString.Nums.Careless.Int {-| Types that can be read from floating point strings. A floating point string is taken to be a string of digits with up to one comma or period mixed in with the digits. -} class (Intable b f, Fractional f) => Floatable b f where float :: b -> f instance Floatable ByteString Float where float = strict_float instance Floatable ByteString Double where float = strict_float instance Floatable ByteString Rational where float = strict_float instance Floatable Lazy.ByteString Float where float = lazy_float instance Floatable Lazy.ByteString Double where float = lazy_float instance Floatable Lazy.ByteString Rational where float = lazy_float strict_float bytes | null bytes = 0 | head bytes == '-' = foldn 0 (tail integer) + nfrac | head bytes == '+' = foldp 0 (tail integer) + pfrac | otherwise = foldp 0 integer + pfrac where foldn = foldl' negative foldp = foldl' positive (integer, fractional) = break point bytes fractional' = tail fractional p = 0.1 ^ length fractional' nfrac | null fractional = 0 | otherwise = foldn 0 fractional' * p pfrac | null fractional = 0 | otherwise = foldp 0 fractional' * p lazy_float bytes | Lazy.null bytes = 0 | Lazy.head bytes == '-' = foldn 0 (Lazy.tail integer) + nfrac | Lazy.head bytes == '+' = foldp 0 (Lazy.tail integer) + pfrac | otherwise = foldp 0 integer + pfrac where foldn = Lazy.foldlChunks (foldl' negative) foldp = Lazy.foldlChunks (foldl' positive) (integer, fractional) = Lazy.break point bytes fractional' = Lazy.tail fractional p = 0.1 ^ Lazy.length fractional' nfrac | Lazy.null fractional = 0 | otherwise = foldn 0 fractional' * p pfrac | Lazy.null fractional = 0 | otherwise = foldp 0 fractional' * p point c = c == '.' || c == ','