ginsu 0.8.1 → 0.8.1.1
raw patch · 16 files changed
+163/−45 lines, 16 filesdep +hashabledep +hashtablessetup-changed
Dependencies added: hashable, hashtables
Files
- Atom.hs +13/−6
- Boolean/Boolean.hs +9/−1
- CacheIO.hs +5/−0
- CircularBuffer.hs +1/−1
- Doc/DocLike.hs +1/−0
- Gale/Gale.hs +1/−0
- Gale/Proto.hs +1/−0
- Gale/Puff.hs +2/−2
- Main.hs +10/−9
- OldHash.hs +58/−0
- PackedString.hs +5/−2
- RSA.hsc +3/−1
- Setup.hs +1/−1
- SimpleParser.hs +10/−5
- Text/ParserCombinators/ReadP/ByteString.hs +37/−14
- ginsu.cabal +6/−3
Atom.hs view
@@ -13,11 +13,13 @@ toPackedString ) where +import System.IO.Unsafe (unsafePerformIO)+ import Data.Generics import Data.Monoid import Foreign import Data.List(sort)-import qualified Data.HashTable as HT+import qualified Data.HashTable.IO as HT import Data.Binary import PackedString@@ -29,12 +31,12 @@ mconcat xs = toAtom $ concatPS (map fromAtom xs) {-# NOINLINE table #-}-table :: HT.HashTable PackedString Atom-table = unsafePerformIO (HT.new (==) (fromIntegral . hashPS))+table :: HT.CuckooHashTable PackedString Atom+table = unsafePerformIO HT.new {-# NOINLINE reverseTable #-}-reverseTable :: HT.HashTable Int PackedString-reverseTable = unsafePerformIO (HT.new (==) (fromIntegral))+reverseTable :: HT.CuckooHashTable Int PackedString+reverseTable = unsafePerformIO HT.new {-# NOINLINE intPtr #-} intPtr :: Ptr Int@@ -51,8 +53,13 @@ readsPrec _ s = [ (fromString s,"") ] --readsPrec p s = [ (fromString x,y) | (x,y) <- readsPrec p s] -toPackedString atom = atomToPS atom+toPackedString :: Atom -> PackedString+toPackedString = atomToPS++toString :: Atom -> String toString atom = unpackPS $ toPackedString atom++atomIndex :: Atom -> Int atomIndex (Atom x) = x instance Binary Atom where
Boolean/Boolean.hs view
@@ -18,9 +18,10 @@ import Boolean.Algebra import Prelude hiding((&&),(||),not,and,or,any,all) import qualified Prelude+import Control.Applicative import Control.Monad import Data.List hiding(and,or)-import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec hiding ((<|>)) @@ -43,12 +44,19 @@ fmap f (BoolOr xs) = BoolOr (map (fmap f) xs) fmap f (BoolJust x) = BoolJust (f x) +instance Applicative Boolean where+ pure = return+ (<*>) = ap instance Monad Boolean where --a >> b = a && b a >>= f = dropBoolean (fmap f a) return x = BoolJust x fail _ = false++instance Alternative Boolean where+ empty = mzero+ (<|>) = mplus instance MonadPlus Boolean where a `mplus` b = a || b
CacheIO.hs view
@@ -23,6 +23,7 @@ ) where +import Control.Applicative import Control.Monad.Trans import Control.Concurrent import Control.Monad@@ -62,6 +63,10 @@ instance Functor CacheIO where fmap = liftM++instance Applicative CacheIO where+ pure = return+ (<*>) = ap instance Monad CacheIO where {-# INLINE (>>=) #-}
CircularBuffer.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ParallelListComp, PatternGuards #-}+{-# LANGUAGE ParallelListComp, PatternGuards, FlexibleContexts #-} module CircularBuffer( CircularBuffer, new,
Doc/DocLike.hs view
@@ -2,6 +2,7 @@ module Doc.DocLike where -- import Data.Monoid hiding ((<>))+import Prelude hiding ((<$>)) import Control.Monad.Reader() import Data.List import qualified Text.PrettyPrint.HughesPJ as P
Gale/Gale.hs view
@@ -33,6 +33,7 @@ import Data.Binary.Put import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS+import Control.Applicative ((<|>)) import Atom import Control.Monad.Error (when, replicateM)
Gale/Proto.hs view
@@ -13,6 +13,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Binary.Get import Data.Word+import Control.Applicative ((<|>)) pubkey_magic3 :: [Word8]
Gale/Puff.hs view
@@ -170,7 +170,7 @@ _ -> fail $ "fragment not found: " ++ toString s mergeFrags :: FragmentList -> FragmentList -> FragmentList-mergeFrags fla flb = fla ++ [f|f@(s,_) <- flb, s `notElem` fsts fla]+mergeFrags fla flb = fla ++ [f | f@(s,_) <- flb, s `notElem` fsts fla] {-@@ -181,7 +181,7 @@ -} getFragmentStrings :: HasFragmentList fl => fl -> Atom -> [PackedString]-getFragmentStrings fl s = [v|(n,FragmentText v) <- getFragmentList fl, n == s]+getFragmentStrings fl s = [v | (n,FragmentText v) <- getFragmentList fl, n == s] getFragmentForceStrings :: HasFragmentList fl => fl -> Atom -> [PackedString] getFragmentForceStrings fl s = concatMap f [v | (n,v) <- getFragmentList fl, n == s] where
Main.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverlappingInstances, PatternGuards, ScopedTypeVariables #-}+{-# LANGUAGE OverlappingInstances, PatternGuards, ScopedTypeVariables, FlexibleContexts #-} module Main(main) where import Data.Char@@ -14,7 +14,7 @@ import Data.Array.IO import Data.IORef import Data.Unique-import qualified Data.HashTable as Hash+import qualified Data.HashTable.IO as Hash import qualified System.Posix as Posix import qualified System.Posix.IO as PosixIO import System.IO@@ -40,6 +40,7 @@ import Help import KeyName import MyLocale+import qualified OldHash import Options import PackedString import Prelude hiding((&&),(||),not,and,or,any,all)@@ -241,7 +242,7 @@ presenceViewUser :: String -> PresenceData -> Widget presenceViewUser user pl = widgetText pt where- pt = user ++ ":\n" ++ indentLines 2 (unlines $ buildTableLL ([b|(a,b) <- pl, a == user]))+ pt = user ++ ":\n" ++ indentLines 2 (unlines $ buildTableLL ([b | (a,b) <- pl, a == user])) @@ -356,8 +357,8 @@ Status.setF "Gale.Presence" (readVal myPresence) - idleHash <- Hash.new (==) Hash.hashString- puffRRHash <- Hash.new (==) Hash.hashString+ idleHash <- Hash.new :: IO (Hash.CuckooHashTable String ClockTime) -- (==) OldHash.hashString+ puffRRHash <- Hash.new :: IO (Hash.CuckooHashTable String [String]) -- (==) OldHash.hashString presenceWidget <- widgetScroll (newSVarWidget presence_r (presenceView idleHash)) @@ -387,7 +388,7 @@ return [(x,puffHeight p xs)| x@(_,p) <- ps, f p] - buf_size <- newCacheIO $ cacheIO getFilteredPuffs >>= \ps -> return $ sum [x| (_,x) <- ps]+ buf_size <- newCacheIO $ cacheIO getFilteredPuffs >>= \ps -> return $ sum [x | (_,x) <- ps] let statusHeight = do fs <- readVal filter_r return $ if length fs == 0 then 1 else 2@@ -436,7 +437,7 @@ Nothing -> return () Just pn -> do let np@(a',(b',_)) = (author, (maybe "unknown" unpackPS (getFragmentString p (fromString "id/instance")), unpackPS pn))- mapVal presence_r (\xs -> (np:[x| x@(a,(b,_)) <- xs, a /= a' || b /= b']))+ mapVal presence_r (\xs -> (np:[x | x@(a,(b,_)) <- xs, a /= a' || b /= b'])) case getFragmentTime p (fromString "status.idle") of Nothing -> return () Just pn | pn == epoch -> Hash.delete idleHash author >> getClockTime >>= Hash.insert idleHash author@@ -448,7 +449,7 @@ Just n | [Category (cat,dom)] <- cats p, dom == domain, ("_gale.rr." ++ name) `isPrefixOf` cat -> do mv <- Hash.lookup puffRRHash (drop (10 + length name) cat) Hash.delete puffRRHash (drop (10 + length name) cat)- Hash.insert puffRRHash (drop (10 + length name) cat) (unpackPS n:concat (maybeToMonad mv))+ Hash.insert puffRRHash (drop (10 + length name) cat) (unpackPS n:concat (maybeToMonad mv :: [[String]])) _ -> return () @@ -931,7 +932,7 @@ Posix.setFileCreationMask om return v -noBodyWords fl = [x|x@(n,_) <- fl, n /= f_messageBody, n /= f_messageKeyword]+noBodyWords fl = [x |x@(n,_) <- fl, n /= f_messageBody, n /= f_messageKeyword] withNBRWorkaround f = do System.IO.stdin `seq` return ()
+ OldHash.hs view
@@ -0,0 +1,58 @@+module OldHash (hashInt, hashString) where++import Data.Bits (shiftR)+import Data.Char (ord)+import Data.Int (Int32, Int64)+import Data.List (foldl')++golden :: Int32+golden = 1013904242 -- = round ((sqrt 5 - 1) * 2^32) :: Int32+-- was -1640531527 = round ((sqrt 5 - 1) * 2^31) :: Int32+-- but that has bad mulHi properties (even adding 2^32 to get its inverse)+-- Whereas the above works well and contains no hash duplications for+-- [-32767..65536]++hashInt32 :: Int32 -> Int32+hashInt32 x = mulHi x golden + x++hashInt :: Int -> Int32+hashInt x = hashInt32 (fromIntegral x)++-- hi 32 bits of a x-bit * 32 bit -> 64-bit multiply+mulHi :: Int32 -> Int32 -> Int32+mulHi a b = fromIntegral (r `shiftR` 32)+ where r :: Int64+ r = fromIntegral a * fromIntegral b++-- | A sample hash function for Strings. We keep multiplying by the+-- golden ratio and adding. The implementation is:+--+-- > hashString = foldl' f golden+-- > where f m c = fromIntegral (ord c) * magic + hashInt32 m+-- > magic = 0xdeadbeef+--+-- Where hashInt32 works just as hashInt shown above.+--+-- Knuth argues that repeated multiplication by the golden ratio+-- will minimize gaps in the hash space, and thus it's a good choice+-- for combining together multiple keys to form one.+--+-- Here we know that individual characters c are often small, and this+-- produces frequent collisions if we use ord c alone. A+-- particular problem are the shorter low ASCII and ISO-8859-1+-- character strings. We pre-multiply by a magic twiddle factor to+-- obtain a good distribution. In fact, given the following test:+--+-- > testp :: Int32 -> Int+-- > testp k = (n - ) . length . group . sort . map hs . take n $ ls+-- > where ls = [] : [c : l | l <- ls, c <- ['\0'..'\xff']]+-- > hs = foldl' f golden+-- > f m c = fromIntegral (ord c) * k + hashInt32 m+-- > n = 100000+--+-- We discover that testp magic = 0.++hashString :: String -> Int32+hashString = foldl' f golden+ where f m c = fromIntegral (ord c) * magic + hashInt32 m+ magic = 0xdeadbeef
PackedString.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module : Data.PackedString@@ -55,6 +55,8 @@ import qualified Data.ByteString.UTF8 as U import qualified Data.String.UTF8 as US import Data.Bits+import GHC.Generics (Generic)+import Data.Hashable import Data.Monoid instance Monoid PackedString where@@ -69,12 +71,13 @@ -- efficient operations. A 'PackedString' contains full Unicode 'Char's. -- much like UTF8 ByteString newtype PackedString = PS { unPS :: U.ByteString }- deriving(Typeable,Binary,Eq,Ord)+ deriving(Typeable,Binary,Eq,Ord,Generic) instance Show PackedString where showsPrec p (PS ps) = showsPrec p (US.fromRep ps) +instance Hashable PackedString -- ----------------------------------------------------------------------------- -- Constructor functions
RSA.hsc view
@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, CPP #-} module RSA( EvpPkey, decryptAll,@@ -17,6 +17,8 @@ import ErrorLog import Foreign import Numeric(showHex)++import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS
Setup.hs view
@@ -20,7 +20,7 @@ info verb $ scs (cmdspec cmd) ++ " > " ++ outf (_,_,_,pid) <- createProcess cmd { std_out = UseHandle out } r <- waitForProcess pid- when (r /= ExitSuccess) $ die $ scs (cmdspec cmd) ++ ": " ++ show r+ when (r /= ExitSuccess) $ Distribution.Simple.Utils.die $ scs (cmdspec cmd) ++ ": " ++ show r scs (ShellCommand s) = s scs (RawCommand c a) = unwords (c:a)
SimpleParser.hs view
@@ -21,12 +21,11 @@ module SimpleParser where -import Data.Char+import Control.Applicative hiding (many) import Control.Monad+import Data.Char import Data.List -infixr 1 <|>- -- very simple parser combinators with failure but limited non-determinism. -- designed for parsing single lines or simple expressions. -- advantages: pure haskell 98, simple.@@ -42,10 +41,18 @@ (MkP p) >>= q = MkP $ \s -> (maybe Nothing (\(v,s') -> app (q v) s') (p s)) fail _ = MkP $ \_ -> Nothing +instance Applicative (GenParser c) where+ pure = return+ (<*>) = ap+ instance Functor (GenParser c) where fmap = liftM +instance Alternative (GenParser c) where+ empty = mzero+ p <|> q = MkP $ \s -> maybe (app q s) Just (app p s) + instance MonadPlus (GenParser c) where mzero = MkP (\_ -> Nothing) mplus = (<|>)@@ -100,8 +107,6 @@ f _ = Nothing satisfy = sat--p <|> q = MkP $ \s -> maybe (app q s) Just (app p s) many :: GenParser c a -> GenParser c [a] many p = (p >>= \x -> many p >>= \xs -> return (x:xs)) <|> return []
Text/ParserCombinators/ReadP/ByteString.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, NoImplicitPrelude, TypeOperators, ExistentialQuantification, PolymorphicComponents #-}+{-# LANGUAGE CPP, NoImplicitPrelude, TypeOperators, ExistentialQuantification, PolymorphicComponents, DeriveFunctor #-} ----------------------------------------------------------------------------- -- | -- Module : Text.ParserCombinators.ReadP.ByteString@@ -71,10 +71,11 @@ ) where +import Control.Applicative (Alternative(empty, (<|>)), Applicative(pure, (<*>))) import Control.Monad ( MonadPlus(..), liftM2, Monad, (>>), (>>=),- return, fail, Functor, fmap, replicateM )+ return, fail, Functor, fmap, replicateM, void, ap ) import Prelude ( (+), (-), (++), Int, Bool(..), (==), error,- fromInteger, (.), (>=), compare, Ordering(..) )+ (.), (>=), compare, Ordering(..), const ) import Data.Word (Word8) import Data.ByteString (ByteString,length,take,takeWhile,null) @@ -107,7 +108,14 @@ | Fail | Result a (P a) | Final [(a,ByteString)] -- invariant: list is non-empty!+ deriving Functor +-- Applicative++instance Applicative P where+ pure = return+ (<*>) = ap+ -- Monad, MonadPlus instance Monad (P) where@@ -121,6 +129,10 @@ fail _ = Fail +instance Alternative P where+ empty = mzero+ (<|>) = mplus+ instance MonadPlus (P) where mzero = Fail @@ -164,11 +176,19 @@ instance Functor (ReadP) where fmap h (R f) = R (\k -> f (k . h)) +instance Applicative (ReadP) where+ pure = return+ (<*>) = ap+ instance Monad (ReadP) where return x = R (\k -> k x)- fail _ = R (\_ -> Fail)+ fail _ = R (const Fail) R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k)) +instance Alternative ReadP where+ empty = mzero+ (<|>) = mplus+ instance MonadPlus (ReadP) where mzero = pfail mplus = (+++)@@ -212,7 +232,7 @@ pfail :: ReadP a -- ^ Always fails.-pfail = R (\_ -> Fail)+pfail = R (const Fail) (+++) :: ReadP a -> ReadP a -> ReadP a -- ^ Symmetric choice.@@ -254,8 +274,8 @@ gath 0 _ | False = Fail gath l (Skip n f) = Skip n (gath (l+n) f) gath _ Fail = Fail- gath l (Look f) = Look (\s -> gath l (f s))- gath l (Result k p) = k (l) `mplus` gath l p+ gath l (Look f) = Look (gath l . f)+ gath l (Result k p) = k l `mplus` gath l p gath _ (Final _) = error "do not use readS_to_P in gather or countsym!" -- ---------------------------------------------------------------------------@@ -309,12 +329,12 @@ skipSpaces :: ReadP () -- ^ Skips all whitespace.-skipSpaces = munch isSpaceWord8 >> return ()+skipSpaces = void (munch isSpaceWord8) count :: Int -> ReadP a -> ReadP [a] -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of -- results is returned.-count n p = replicateM n p+count = replicateM between :: ReadP open -> ReadP close -> ReadP a -> ReadP a -- ^ @between open close p@ parses @open@, followed by @p@ and finally@@ -331,7 +351,7 @@ optional :: ReadP a -> ReadP () -- ^ @optional p@ optionally parses @p@ and always returns @()@.-optional p = (p >> return ()) +++ return ()+optional p = void p +++ return () many :: ReadP a -> ReadP [a] -- ^ Parses zero or more occurrences of the given parser.@@ -343,7 +363,7 @@ skipMany :: ReadP a -> ReadP () -- ^ Like 'many', but discards the result.-skipMany p = many p >> return ()+skipMany p = void (many p) skipMany1 :: ReadP a -> ReadP () -- ^ Like 'many1', but discards the result.@@ -359,15 +379,18 @@ -- Returns a list of values returned by @p@. sepBy1 p sep = liftM2 (:) p (many (sep >> p)) +endByDo :: ReadP a -> ReadP sep -> ReadP a+endByDo p sep = do x <- p ; sep ; return x+ endBy :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended -- by @sep@.-endBy p sep = many (do x <- p ; sep ; return x)+endBy p sep = many (endByDo p sep) endBy1 :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended -- by @sep@.-endBy1 p sep = many1 (do x <- p ; sep ; return x)+endBy1 p sep = many1 (endByDo p sep) chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.@@ -404,7 +427,7 @@ -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@ -- succeeds. Returns a list of values returned by @p@. manyTill p end = scan- where scan = (end >> return []) <++ (liftM2 (:) p scan)+ where scan = (end >> return []) <++ liftM2 (:) p scan -- --------------------------------------------------------------------------- -- Converting between ReadP and Read
ginsu.cabal view
@@ -1,6 +1,6 @@ -- vim:et Name: ginsu-Version: 0.8.1+Version: 0.8.1.1 Copyright: 2002-2009 John Meacham <john@repetae.net> 2011-2012 Dylan Simon <dylan@dylex.net> Author: John Meacham <john@foo.net>@@ -14,7 +14,7 @@ Category: Network,Console Build-Type: Custom Cabal-Version: >= 1.6-tested-with: GHC == 6.12.3, GHC == 7.6.1+tested-with: GHC == 7.8.4, GHC == 7.10.1 extra-source-files: configure ginsu.buildinfo.in@@ -64,6 +64,7 @@ KeyHelpTable KeyName MyLocale+ OldHash Options PackedString Paths_ginsu@@ -96,5 +97,7 @@ syb, network, parsec,- process+ process,+ hashtables,+ hashable Extra-Libraries: ssl crypto