MissingH 1.4.1.0 → 1.4.2.0
raw patch · 69 files changed
+1057/−1371 lines, 69 filesdep +MissingHdep +network-bsddep −QuickCheckdep −testpackdep ~HUnitdep ~arraydep ~basesetup-changednew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: MissingH, network-bsd
Dependencies removed: QuickCheck, testpack
Dependency ranges changed: HUnit, array, base, containers, directory, errorcall-eq-instance, filepath, hslogger, mtl, network, old-locale, old-time, parsec, process, random, regex-compat, time, unix
API changes (from Hackage documentation)
- Data.Hash.MD5.Zord64_HARD: data Zord64
- Data.Hash.MD5.Zord64_HARD: instance Data.Bits.Bits Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Classes.Eq Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Classes.Ord Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Enum.Bounded Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Enum.Enum Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Num.Num Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Read.Read Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Real.Integral Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Real.Real Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5.Zord64_HARD: instance GHC.Show.Show Data.Hash.MD5.Zord64_HARD.Zord64
- Data.Hash.MD5: md5 :: (MD5 a) => a -> ABCD
+ Data.Hash.MD5: md5 :: MD5 a => a -> ABCD
- Data.Hash.MD5: md5i :: (MD5 a) => a -> Integer
+ Data.Hash.MD5: md5i :: MD5 a => a -> Integer
- Data.Hash.MD5: md5s :: (MD5 a) => a -> String
+ Data.Hash.MD5: md5s :: MD5 a => a -> String
- Data.List.Utils: merge :: (Ord a) => [a] -> [a] -> [a]
+ Data.List.Utils: merge :: Ord a => [a] -> [a] -> [a]
- System.Debian.ControlParser: depPart :: CharParser a (String, (Maybe (String, String)), [String])
+ System.Debian.ControlParser: depPart :: CharParser a (String, Maybe (String, String), [String])
- System.IO.Binary: getBufStr :: (BinaryConvertible b) => Int -> IO [b]
+ System.IO.Binary: getBufStr :: BinaryConvertible b => Int -> IO [b]
- System.IO.Binary: putBufStr :: (BinaryConvertible b) => [b] -> IO ()
+ System.IO.Binary: putBufStr :: BinaryConvertible b => [b] -> IO ()
- Text.ParserCombinators.Parsec.Utils: allg :: (Show a) => GeneralizedTokenParser a st [a]
+ Text.ParserCombinators.Parsec.Utils: allg :: Show a => GeneralizedTokenParser a st [a]
- Text.ParserCombinators.Parsec.Utils: satisfyg :: (Show a) => (a -> Bool) -> GeneralizedTokenParser a st a
+ Text.ParserCombinators.Parsec.Utils: satisfyg :: Show a => (a -> Bool) -> GeneralizedTokenParser a st a
- Text.ParserCombinators.Parsec.Utils: tokeng :: (Show a) => (a -> Maybe b) -> GeneralizedTokenParser a st b
+ Text.ParserCombinators.Parsec.Utils: tokeng :: Show a => (a -> Maybe b) -> GeneralizedTokenParser a st b
Files
- CHANGES.md +21/−0
- Makefile +0/−47
- MissingH.cabal +184/−121
- Setup.hs +0/−3
- TODO +0/−33
- pending/Gopher.hs +0/−86
- pending/Maildir.disabled +0/−76
- pending/Tar.newhs +0/−61
- pending/Tar/HeaderParser.newhs +0/−98
- src/Control/Concurrent/Thread/Utils.hs +3/−4
- src/Data/BinPacking.hs +1/−2
- src/Data/Bits/Utils.hs +5/−6
- src/Data/CSV.hs +2/−3
- src/Data/Compression/Inflate.hs +19/−21
- src/Data/Either/Utils.hs +9/−10
- src/Data/Hash/CRC32/GZip.hs +8/−9
- src/Data/Hash/MD5.hs +354/−0
- src/Data/Hash/MD5.lhs +0/−359
- src/Data/Hash/MD5/Zord64_HARD.hs +53/−0
- src/Data/Hash/MD5/Zord64_HARD.lhs +0/−48
- src/Data/List/Utils.hs +23/−22
- src/Data/MIME/Types.hs +3/−2
- src/Data/Map/Utils.hs +5/−6
- src/Data/Maybe/Utils.hs +2/−3
- src/Data/Progress/Meter.hs +3/−2
- src/Data/Progress/Tracker.hs +1/−2
- src/Data/Quantity.hs +18/−19
- src/Data/String/Utils.hs +7/−6
- src/Data/Tuple/Utils.hs +2/−3
- src/Network/Email/Mailbox.hs +1/−2
- src/Network/Email/Sendmail.hs +3/−2
- src/Network/SocketServer.hs +29/−28
- src/Network/Utils.hs +10/−9
- src/System/Cmd/Utils.hs +3/−2
- src/System/Console/GetOpt/Utils.hs +7/−8
- src/System/Daemon.hs +8/−7
- src/System/Debian.hs +9/−7
- src/System/Debian/ControlParser.hs +5/−4
- src/System/FileArchive/GZip.hs +18/−19
- src/System/IO/Binary.hs +3/−2
- src/System/IO/HVFS.hs +3/−3
- src/System/IO/HVFS/Combinators.hs +12/−11
- src/System/IO/HVFS/InstanceHelpers.hs +17/−15
- src/System/IO/HVFS/Utils.hs +27/−27
- src/System/IO/HVIO.hs +14/−16
- src/System/IO/PlafCompat.hs +5/−6
- src/System/IO/StatCompat.hs +15/−16
- src/System/IO/Utils.hs +7/−6
- src/System/IO/WindowsCompat.hs +1/−2
- src/System/Path.hs +15/−19
- src/System/Path/Glob.hs +10/−8
- src/System/Path/NameManip.hs +5/−6
- src/System/Path/WildMatch.hs +15/−14
- src/System/Posix/Consts.hs +2/−4
- src/System/Time/Utils.hs +9/−10
- src/Text/ParserCombinators/Parsec/Utils.hs +5/−6
- testsrc/Eithertest.hs +8/−9
- testsrc/Globtest.hs +3/−1
- testsrc/HVFStest.hs +1/−1
- testsrc/HVIOtest.hs +11/−11
- testsrc/IOtest.hs +1/−1
- testsrc/Listtest.hs +16/−17
- testsrc/Strtest.hs +1/−1
- testsrc/TestUtils.hs +34/−0
- testsrc/Tests.hs +0/−2
- testsrc/WildMatchtest.hs +1/−1
- tolgpl +0/−7
- winbuild.bat +0/−4
- wintest.bat +0/−5
+ CHANGES.md view
@@ -0,0 +1,21 @@+### 1.4.2.0++- Fix regression (introduced in 1.4.1.0 release) in `Data.Compression.Inflate`+- Drop redundant dependency on `HUnit`+- Add more explicit `SafeHaskell` annotations to modules; all modules+ except for `System.Debian` are now explicitly either `Safe` or `Trustworthy`+- Add support for `network-3.0` and `network-3.1`++## 1.4.1.0++- Support for GHC 8.6.1 / `base-4.12` ([#45](https://github.com/haskell-hvr/missingh/issues/45))++### 1.4.0.1++- Restore compatibility with GHC 7.4.2++# 1.4.0.0++- Removal of `Data.Hash.CRC32.Posix` and `System.Time.Utils.ParseDate`++- Added explicit `SafeHaskell` annotations to modules
− Makefile
@@ -1,47 +0,0 @@-# Copyright (C) 2004 - 2009 John Goerzen <jgoerzen@complete.org>-#-# This library is free software; you can redistribute it and/or-# modify it under the terms of the GNU Lesser General Public-# License as published by the Free Software Foundation; either-# version 2.1 of the License, or (at your option) any later version.-#-# This library is distributed in the hope that it will be useful,-# but WITHOUT ANY WARRANTY; without even the implied warranty of-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU-# Lesser General Public License for more details.-#-# You should have received a copy of the GNU Lesser General Public-# License along with this library; if not, write to the Free Software-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA-all: setup- @echo "Please use Cabal to build this package; not make."- ./setup configure- ./setup build--setup: Setup.hs- ghc --make -o setup Setup.hs--install: setup- ./setup install--clean:- runghc ./Setup.hs clean--.PHONY: test-test: test-ghc test-hugs- @echo ""- @echo "All tests pass."--test-hugs: setup- @echo " ****** Running hugs tests"- ./setup configure -f buildtests --hugs- ./setup build- runhugs -98 +o -P$(PWD)/dist/scratch:$(PWD)/dist/scratch/programs/runtests: \- dist/scratch/programs/runtests/Main.hs--test-ghc: setup- @echo " ****** Building GHC tests"- ./setup configure -f buildtests- ./setup build- @echo " ****** Running GHC tests"- ./dist/build/runtests/runtests
MissingH.cabal view
@@ -1,131 +1,194 @@-Name: MissingH-Version: 1.4.1.0-License: BSD3-Maintainer: John Goerzen <jgoerzen@complete.org>-Author: John Goerzen-Copyright: Copyright (c) 2004-2018 John Goerzen+cabal-version: 1.12+name: MissingH+version: 1.4.2.0++build-type: Simple+license: BSD3+author: John Goerzen+copyright: Copyright (c) 2004-2018 John Goerzen+maintainer: Herbert Valerio Riedel <hvr@gnu.org> license-file: LICENSE-extra-source-files: LICENSE,- announcements/0.10.0.txt,- announcements/0.8.0.txt,- announcements/0.9.0.txt,- testsrc/gzfiles/empty.gz,- testsrc/gzfiles/t1.gz,- testsrc/gzfiles/t1bad.gz,- testsrc/gzfiles/t2.gz,- testsrc/gzfiles/zeros.gz,- testsrc/mime.types.test,- 3rd-party-licenses/BSD,- 3rd-party-licenses/LGPL-2.1,- Makefile,- TODO,- examples/simplegrep.hs,- examples/test2.hs,- examples/test3.hs,- pending/Gopher.hs,- pending/Maildir.disabled,- pending/Tar.newhs,- pending/Tar/HeaderParser.newhs,- tolgpl,- winbuild.bat,- wintest.bat-homepage: http://software.complete.org/missingh-Category: Unclassified+tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+ synopsis: Large utility library-Description: MissingH is a library of all sorts of utility functions for- Haskell programmers. It is written in pure Haskell and thus should- be extremely portable and easy to use.-Stability: Beta-Build-Type: Simple-Cabal-Version: >=1.8+description:+ @MissingH@ is a library of all sorts of utility functions for Haskell+ programmers. It is written in pure Haskell and thus should be+ extremely portable and easy to use.+category: Unclassified+bug-reports: https://github.com/hvr/missingh/issues -Library- Hs-Source-Dirs: src- Exposed-Modules:- Data.String.Utils, System.IO.Utils, System.IO.Binary, Data.List.Utils,- System.Daemon,- Text.ParserCombinators.Parsec.Utils,- Network.Email.Mailbox,- Control.Concurrent.Thread.Utils,- Network.Email.Sendmail,- Data.CSV,- System.Cmd.Utils,- Data.BinPacking,- Data.Progress.Tracker,- Data.Progress.Meter,- Data.Quantity,- Data.Map.Utils, System.Path, System.Path.NameManip,- System.Path.WildMatch, System.Path.Glob,- System.Time.Utils,- Network.Utils,- Network.SocketServer,- Data.Either.Utils,- Data.Maybe.Utils,- Data.Tuple.Utils,- Data.Bits.Utils,- Data.Hash.CRC32.GZip,- Data.Hash.MD5, Data.Hash.MD5.Zord64_HARD,- Data.Compression.Inflate,- System.FileArchive.GZip,- System.IO.HVFS,- System.IO.HVFS.Combinators,- System.IO.HVFS.InstanceHelpers,- System.IO.HVFS.Utils,- System.IO.HVIO, System.IO.StatCompat, System.IO.WindowsCompat,- System.IO.PlafCompat, System.Posix.Consts,- System.Debian, System.Debian.ControlParser,- Data.MIME.Types,- System.Console.GetOpt.Utils+extra-source-files:+ CHANGES.md+ LICENSE+ announcements/0.10.0.txt+ announcements/0.8.0.txt+ announcements/0.9.0.txt+ testsrc/gzfiles/empty.gz+ testsrc/gzfiles/t1.gz+ testsrc/gzfiles/t1bad.gz+ testsrc/gzfiles/t2.gz+ testsrc/gzfiles/zeros.gz+ testsrc/mime.types.test+ 3rd-party-licenses/BSD+ 3rd-party-licenses/LGPL-2.1+ examples/simplegrep.hs+ examples/test2.hs+ examples/test3.hs - Extensions: ExistentialQuantification, OverlappingInstances,- UndecidableInstances, CPP, Rank2Types,- MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,- ScopedTypeVariables+flag network--GE-3_0_0+ description: [network](http://hackage.haskell.org/package/network) ≥ 3.0.0+ default: True+ manual: False - Build-Depends: network, parsec, base,- mtl, HUnit, regex-compat,- filepath,- hslogger,- base >= 4.5, base < 5, directory, random, process, old-time,- containers, old-locale, array, time- If ! os(windows)- Build-Depends: unix+source-repository head+ type: git+ location: https://github.com/hvr/missingh.git +library+ hs-source-dirs: src+ exposed-modules:+ Control.Concurrent.Thread.Utils+ Data.BinPacking+ Data.Bits.Utils+ Data.CSV+ Data.Compression.Inflate+ Data.Either.Utils+ Data.Hash.CRC32.GZip+ Data.Hash.MD5+ Data.Hash.MD5.Zord64_HARD+ Data.List.Utils+ Data.MIME.Types+ Data.Map.Utils+ Data.Maybe.Utils+ Data.Progress.Meter+ Data.Progress.Tracker+ Data.Quantity+ Data.String.Utils+ Data.Tuple.Utils+ Network.Email.Mailbox+ Network.Email.Sendmail+ Network.SocketServer+ Network.Utils+ System.Cmd.Utils+ System.Console.GetOpt.Utils+ System.Daemon+ System.Debian+ System.Debian.ControlParser+ System.FileArchive.GZip+ System.IO.Binary+ System.IO.HVFS+ System.IO.HVFS.Combinators+ System.IO.HVFS.InstanceHelpers+ System.IO.HVFS.Utils+ System.IO.HVIO+ System.IO.PlafCompat+ System.IO.StatCompat+ System.IO.Utils+ System.IO.WindowsCompat+ System.Path+ System.Path.Glob+ System.Path.NameManip+ System.Path.WildMatch+ System.Posix.Consts+ System.Time.Utils+ Text.ParserCombinators.Parsec.Utils++ default-language: Haskell2010+ default-extensions:+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ MultiParamTypeClasses+ OverlappingInstances+ Rank2Types+ ScopedTypeVariables+ UndecidableInstances+ other-extensions:+ CPP+ Safe+ Trustworthy+ TypeSynonymInstances++ build-depends:+ array >= 0.4.0.0 && < 0.6+ , base >= 4.5.0.0 && < 4.13+ , containers >= 0.4.2.1 && < 0.7+ , directory >= 1.1.0.2 && < 1.4+ , filepath >= 1.3.0.0 && < 1.5+ , hslogger >= 1.3.0.0 && < 1.4+ , mtl >= 1.1.1.0 && < 2.3+ , old-locale == 1.0.*+ , old-time == 1.1.*+ , parsec == 3.1.* && (< 3.1.12 || >= 3.1.13)+ , process >= 1.1.0.1 && < 1.7+ , random >= 1.0.1.1 && < 1.2+ , regex-compat >= 0.95.1 && < 0.96+ , time >= 1.4 && < 1.10++ if flag(network--GE-3_0_0)+ build-depends: network-bsd >= 2.8.1 && <2.9,+ network >= 3.0 && <3.2+ else+ build-depends: network >= 2.6.3.1 && <2.9++ If !os(windows)+ Build-Depends: unix >= 2.5.1.0 && < 2.8++ ghc-options: -fno-warn-deprecations++----------------------------------------------------------------------------+ test-suite runtests- type: exitcode-stdio-1.0+ type: exitcode-stdio-1.0 - Build-Depends: network, parsec, base,- mtl, HUnit, regex-compat,- errorcall-eq-instance,- filepath,- hslogger,- base >= 4.5, base < 5, directory, random, process, old-time,- containers, old-locale, array, time- If ! os(windows)- Build-Depends: unix- Build-Depends: testpack, QuickCheck, HUnit+ hs-source-dirs: testsrc+ main-is: runtests.hs+ other-modules:+ TestUtils - Main-Is: runtests.hs- HS-Source-Dirs: testsrc, ., src- Other-Modules: Bitstest,- CRC32GZIPtest,- Eithertest,- GZiptest,- Globtest,- HVFStest,- HVIOtest,- IOtest,- Listtest,- MIMETypestest,- Maptest,- Pathtest,- ProgressTrackertest,- Str.CSVtest,- Strtest,- Tests,- Timetest,+ Bitstest+ CRC32GZIPtest+ Eithertest+ GZiptest+ Globtest+ HVFStest+ HVIOtest+ IOtest+ Listtest+ MIMETypestest+ Maptest+ Pathtest+ ProgressTrackertest+ Str.CSVtest+ Strtest+ Tests+ Timetest WildMatchtest- Extensions: ExistentialQuantification, OverlappingInstances,- UndecidableInstances, CPP, Rank2Types,- MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,- ScopedTypeVariables++ default-language: Haskell2010++ -- intra-package dependency+ build-depends: MissingH++ -- deps with version bounds inherited via lib:MissingH component+ build-depends:+ base+ , containers+ , directory+ , filepath+ , old-time+ , parsec+ , regex-compat+ , time++ if !os(windows)+ build-depends: unix++ -- additional testsuite-specific dependencies+ build-depends:+ HUnit == 1.6.*+-- , QuickCheck == 2.7.*+ , errorcall-eq-instance == 0.3.*++ ghc-options: -fno-warn-deprecations
Setup.hs view
@@ -1,5 +1,2 @@-#!/usr/bin/env runhugs- import Distribution.Simple- main = defaultMain
− TODO
@@ -1,33 +0,0 @@-Document MissingH/Quantity and see if it has tests yet--Test forceEitherMsg--Cmd: pOpenBoth -- read and write, use forkIO for one of them--tests for new Parsec stuff--HVFStest:- test all sorts of exceptions- test .. et al--FTP server:- timeouts- Proper error checking lots of places, esp. runDataChan--CSVtest:- Test CSV generation--Add Quantity and ProgressTracker to README-----------------------------------------------------From: Jeremy Shaw -The patch to MissingH.HUnit includes a modified version of the 'tests' function-from Test.QuickCheck. That module has the license:---- Module : Test.QuickCheck--- Copyright : (c) Koen Claessen, John Hughes 2001--- License : BSD-style (see the file libraries/base/LICENSE)--If this is problematic, let me know, and I can rewrite it.--j.
− pending/Gopher.hs
@@ -1,86 +0,0 @@-{- arch-tag: Gopher support-Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- |- Module : MissingH.Network.Gopher- Copyright : Copyright (C) 2004 John Goerzen- License : GNU GPL, version 2 or above-- Maintainer : John Goerzen, - Maintainer : jgoerzen@complete.org- Stability : experimental- Portability: systems with networking--This module provides types and generic support for Gopher clients or serves.--Related standards: RFC1436 <http://www.faqs.org/rfcs/rfc1436.html>,-Gopher+ spec <gopher://gopher.quux.org/1/Archives/mirrors/boombox.micro.umn.edu/pub/gopher/gopher_protocol/Gopher%2B/Gopher%2B.txt>--Written by John Goerzen, jgoerzen\@complete.org--}--module MissingH.Network.Gopher (-- * Types- GopherEntry(..)- )- where--import MissingH.Printf-import MissingH.Str-import Data.FiniteMap--{- | Type representing an entry in a Gopher directory.--May add more Gopher+ stuff in here down the road.--You can show a 'GopherEntry'. This will produce a one-line string suitable-for use on a Gopher server.--You can 'read' to a 'GopherEntry'. This will parse a string as a one-line-piece of text suitable for use generating a 'GopherEntry'.--Neither show nor read will consider the 'ea' member. -}-data GopherEntry = GopherEntry - {- selector :: String, -- ^ Path to file on server- gophertype :: Char, -- ^ Gopher0 type character- name :: String, -- ^ Gopher menu name- host :: String, -- ^ Content host name- port :: Integer, -- ^ Remote port- gopherpsupport :: Bool, -- ^ Whether Gopher+ is supported- ea :: FiniteMap String String -- ^ Gopher+ extended attributes- }--instance Show GopherEntry where- show x = let basic = vsprintf "%c%s\t%s\t%s\t%d"- (gophertype x) (name x) (selector x) (host x)- (port x)- in if gopherpsupport x then- basic ++ "\t+"- else basic--instance Read GopherEntry where- read s = let parts = split "\t" s- in- GopherEntry {selector = parts !! 2,- gophertype = head (parts !! 0),- name = parts !! 1,- host = parts !! 3,- port = read (parts !! 4),- gopherpsupport = length parts > 5 && (parts !! 5 == "+"),- ea = emptyFM- }
− pending/Maildir.disabled
@@ -1,76 +0,0 @@-{--Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- |- Module : MissingH.Email.Mailbox.Maildir- Copyright : Copyright (C) 2005 John Goerzen- License : GNU GPL, version 2 or above-- Maintainer : John Goerzen <jgoerzen@complete.org> - Stability : provisional- Portability: portable--Support for Maildir-style mailboxes.--Information about the Maildir format can be found at:-- * <http://www.qmail.org/qmail-manual-html/man5/maildir.html>-- * <http://cr.yp.to/proto/maildir.html>--Written by John Goerzen, jgoerzen\@complete.org--}--module MissingH.Email.Mailbox.Maildir(Maildir(..), readMaildir)-where--import MissingH.Email.Mailbox-import System.Posix.IO(OpenMode(..))-import System.Directory-import MissingH.Path-import MissingH.Maybe-import Control.Monad-import Text.Regex--data Maildir = Maildir - {loc :: FilePath}-instance Show Maildir- where show x = loc x- -{--splitFN :: String -> (String, Flags)- -splitFN fn = - - where (base, fstr) = - case span (/= ':') of- (h, []) = (h, [])- (h, f) = (h, tail f)---}-{- | Open a Maildir mailbox. -}--- For reading only, for now.--openMaildir :: FilePath -> IO Maildir-openMaildir fp =- do cwd <- getCurrentDirectory- let abspath = forceMaybeMsg "abspath readMaildir" $ absNormPath cwd fp- c <- getDirectoryContents fp- unless ("cur" `elem` c && "new" `elem` c && "tmp" `elem` c)- $ error (fp ++ " is not a valid Maildir.")- return (Maildir fp)
− pending/Tar.newhs
@@ -1,61 +0,0 @@-{--Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- |- Module : MissingH.FileArchive.Tar- Copyright : Copyright (C) 2005 John Goerzen- License : GNU GPL, version 2 or above-- Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional- Portability: portable--Tar file format handler--Copyright (c) 2005 John Goerzen, jgoerzen\@complete.org---}-module MissingH.FileArchive.Tar (-- )-where--import MissingH.Checksum.CRC32.GZip-import MissingH.List-import Data.List-import Data.Bits-import Control.Monad.Error-import Control.Monad.State-import Data.Char-import Data.Word-import MissingH.Bits-import System.IO-import Numeric--type Section = (Header, [Word8])--data GZipError = CRCError -- ^ CRC-32 check failed- | NotGZIPFile -- ^ Couldn't find a GZip header- | UnknownMethod -- ^ Compressed with something other than method 8 (deflate)- | UnknownError String -- ^ Other problem arose- deriving (Eq, Show)--instance Error GZipError where- noMsg = UnknownError ""- strMsg = UnknownError-
− pending/Tar/HeaderParser.newhs
@@ -1,98 +0,0 @@-{--Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- |- Module : MissingH.FileArchive.Tar.HeaderParser- Copyright : Copyright (C) 2005 John Goerzen- License : GNU GPL, version 2 or above-- Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional- Portability: portable--Parser for tar-format headers.--Copyright (c) 2005 John Goerzen, jgoerzen\@complete.org---}-module MissingH.FileArchive.Tar.HeaderParser- (-- )--where--import Text.ParserCombinators.Parsec-import Data.Word-import Numeric--{- | The data structure representing the Tar header. This occurs-at the beginning of each 'Section'. -}-data Header = - UStar {- name :: String,- mode :: Int,- uid :: Int,- gid :: Int,- size :: Integer,- mtime :: Integer,- chksum :: Word32,- typeflag :: Char,- linkname :: String,- magic :: String,- version :: String,- uname :: String,- gname :: String,- devmajor :: Integer,- devminor :: Integer,- prefix :: String}- deriving (Eq, Show)--parseUStarHeader :: CharParser st Header-parseUStarHeader =- do name <- (grab 100 >>= rchopstr)- mode <- (grab 8 >>= rreadoct)- uid <- (grab 8 >>= rreadoct)- gid <- (grab 8 >>= rreadoct)- size <- (grab 8 >>= rreadoct)- mtime <- (grab 12 >>= rreadoct)- chksum <- (grab 8 >>= rreadoct)- typeflag <- anyChar- linkname <- (grab 100 >>= rchopstr)- string "ustar\0" -- Magic- string "00" -- Version- uname <- (grab 32 >>= rchopstr)- gname <- (grab 32 >>= rchopstr)- devmajor <- (grab 8 >>= rreadoct)- devminor <- (grab 8 >>= rreadoct)- prefix <- (grab 155 >>= rchopstr)-- return $ UStar {name = name, mode = mode, uid = uid, gid = gid,- size = size, mtime = mtime, chksum = chksum,- typeflag = typeflag, linkname = linkname,- magic = "", version = "",- uname = uname, gname = gname, devmajor = devmajor,- devminor = devminor, prefix = prefix}- where grab n = count n anyChar- chopstr = takeWhile (\c -> c /= '\0')- rchopstr = return . chopstr- chopsstr = takeWhile (\c -> c /= ' ') . chopstr- readoct :: (Num a) => String -> a- readoct = fst . head . readOct . chopsstr- rreadoct :: (Num a, Monad m) => String -> m a- rreadoct = return . readoct
src/Control/Concurrent/Thread/Utils.hs view
@@ -10,9 +10,8 @@ {- | Module : Control.Concurrent.Thread.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -26,9 +25,9 @@ ) where -import Control.Concurrent+import Control.Concurrent -{- | Takes a IO action and a function. The IO action will be called in a +{- | Takes a IO action and a function. The IO action will be called in a separate thread. When it is completed, the specified function is called with its result. This is a simple way of doing callbacks. -}
src/Data/BinPacking.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.BinPacking Copyright : Copyright (C) 2008-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/Data/Bits/Utils.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.Bits.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable to platforms with rawSystem @@ -24,8 +23,8 @@ module Data.Bits.Utils(getBytes, fromBytes, c2w8, s2w8, w82c, w82s) where-import Data.Bits-import Data.Word+import Data.Bits+import Data.Word {- | Returns a list representing the bytes that comprise a data type. @@ -34,7 +33,7 @@ > getBytes (0x12345678::Int) -> [0x12, 0x34, 0x56, 0x78] -} getBytes :: (Integral a, Bounded a, Bits a) => a -> [a]-getBytes input = +getBytes input = let getByte _ 0 = [] getByte x remaining = (x .&. 0xff) : getByte (shiftR x 8) (remaining - 1) in@@ -51,7 +50,7 @@ fromBytes :: (Bits a, Num a) => [a] -> a fromBytes input =- let dofb accum [] = accum+ let dofb accum [] = accum dofb accum (x:xs) = dofb ((shiftL accum 8) .|. x) xs in dofb 0 input
src/Data/CSV.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.CSV Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -50,7 +49,7 @@ lines; each line is a list of cells; and each cell is a String. Please note that CSV files may have a different number of cells on each line.-Also, it is impossible to distinguish a CSV line that has a call with no data+Also, it is impossible to distinguish a CSV line that has a cell with no data from a CSV line that has no cells. Here are some examples:
src/Data/Compression/Inflate.hs view
@@ -16,11 +16,9 @@ {- | Module : Data.Compression.Inflate- Copyright : Copyright (C) 2004 Ian Lynagh - License : 3-clause BSD+ Copyright : Copyright (C) 2004 Ian Lynagh+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : Ian Lynagh, - Maintainer : <igloo@earth.li> Stability : provisional Portability: portable @@ -34,15 +32,15 @@ inflate, Output, Bit, bits_to_word32) where -import Data.Array-import Data.List-import Data.Maybe+import Control.Applicative+import Control.Monad+import Data.Array import qualified Data.Char-import Control.Applicative-import Control.Monad+import Data.List+import Data.Maybe -import Data.Bits-import Data.Word+import Data.Bits+import Data.Word inflate_string :: String -> String inflate_string = fst . inflate_string_remainder@@ -92,7 +90,7 @@ showList bs = showString $ "'" ++ map show_b bs ++ "'" show_b :: Bit -> Char-show_b (Bit True) = '1'+show_b (Bit True) = '1' show_b (Bit False) = '0' int_to_bits :: Int -> [Bit]@@ -111,10 +109,10 @@ offset is rarely used, so make it strict to avoid building huge closures. -}-data State = State { bits :: [Bit], -- remaining input bits- offset :: !Word32, -- num bits consumed mod 8+data State = State { bits :: [Bit], -- remaining input bits+ offset :: !Word32, -- num bits consumed mod 8 history :: Array Word32 Word32, -- last 32768 output words- loc :: Word32 -- where in history we are+ loc :: Word32 -- where in history we are } data InfM a = InfM (State -> (a, State)) @@ -152,8 +150,8 @@ (ys, zs) -> (ys, s { bits = zs, offset = (n + offset s) `mod` 8 } )- where need 0 xs = ([], xs)- need _ [] = error "get_bits: Don't have enough!"+ where need 0 xs = ([], xs)+ need _ [] = error "get_bits: Don't have enough!" need i (x:xs) = let (ys, zs) = need (i-1) xs in (x:ys, zs) extract_InfM :: InfM a -> (a, [Bit])@@ -188,8 +186,8 @@ get_bit :: InfM Bit get_bit = do res <- get_bits 1 case res of- _ -> error $ "get_bit: expected exactly one bit" [x] -> return x+ _ -> error $ "get_bit: expected exactly one bit" {- \section{Inflate itself}@@ -249,8 +247,8 @@ triple :: [a] -> [[a]] triple (a:b:c:xs) = [a,b,c]:triple xs-triple [] = []-triple _ = error "triple: can't happen"+triple [] = []+triple _ = error "triple: can't happen" make_lit_dist_lengths :: Table -> Word32 -> Word32 -> InfM [Word32] make_lit_dist_lengths _ i _ | i < 0 = error "make_lit_dist_lengths i < 0"@@ -348,7 +346,7 @@ make_table :: [(Length, Code)] -> Table make_table lcs = case make_tree 0 $ sort $ filter ((/= 0) . fst) lcs of (tree, []) -> get_code tree- _ -> error $ "make_table: Left-over lcs from"+ _ -> error $ "make_table: Left-over lcs from" get_code :: Tree -> InfM Code get_code (Branch zero_tree one_tree)
src/Data/Either/Utils.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.Either.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -27,7 +26,7 @@ eitherToMonadError, fromLeft, fromRight, fromEither ) where-import Control.Monad.Error+import Control.Monad.Error {- | Converts a Maybe value to an Either value, using the supplied parameter as the Left value if the Maybe is Nothing.@@ -43,39 +42,39 @@ e -- ^ (Left e) will be returned if the Maybe value is Nothing -> Maybe a -- ^ (Right a) will be returned if this is (Just a) -> m a-maybeToEither errorval Nothing = throwError errorval+maybeToEither errorval Nothing = throwError errorval maybeToEither _ (Just normalval) = return normalval {- | Pulls a "Right" value out of an Either value. If the Either value is Left, raises an exception with "error". -} forceEither :: Show e => Either e a -> a-forceEither (Left x) = error (show x)+forceEither (Left x) = error (show x) forceEither (Right x) = x {- | Like 'forceEither', but can raise a specific message with the error. -} forceEitherMsg :: Show e => String -> Either e a -> a forceEitherMsg msg (Left x) = error $ msg ++ ": " ++ show x-forceEitherMsg _ (Right x) = x+forceEitherMsg _ (Right x) = x {- | Takes an either and transforms it into something of the more generic MonadError class. -} eitherToMonadError :: MonadError e m => Either e a -> m a-eitherToMonadError (Left x) = throwError x+eitherToMonadError (Left x) = throwError x eitherToMonadError (Right x) = return x -- | Take a Left to a value, crashes on a Right fromLeft :: Either a b -> a fromLeft (Left a) = a-fromLeft _ = error "Data.Either.Utils.fromLeft: Right"+fromLeft _ = error "Data.Either.Utils.fromLeft: Right" -- | Take a Right to a value, crashes on a Left fromRight :: Either a b -> b fromRight (Right a) = a-fromRight _ = error "Data.Either.Utils.fromRight: Left"+fromRight _ = error "Data.Either.Utils.fromRight: Left" -- | Take an Either, and return the value inside it fromEither :: Either a a -> a-fromEither (Left a) = a+fromEither (Left a) = a fromEither (Right a) = a
src/Data/Hash/CRC32/GZip.hs view
@@ -10,25 +10,24 @@ {- | Module : Data.Hash.CRC32.GZip Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable CRC32 checksumming using the GZIP\/PKZIP algorithm as used in both-ISO 3309 and section 8.1.1.6.2 of ITU-T V.42 and referenced in +ISO 3309 and section 8.1.1.6.2 of ITU-T V.42 and referenced in RFC1952. -} module Data.Hash.CRC32.GZip where -import Data.Array-import Data.Bits-import Data.Word-import Data.List-import Data.Char+import Data.Array+import Data.Bits+import Data.Char+import Data.List+import Data.Word update_crc :: Word32 -> Char -> Word32 update_crc crc ch =@@ -43,7 +42,7 @@ calc_crc32 :: [Char] -> Word32 calc_crc32 s = update_crc_list 0 s- + gzipcrctab :: Array Int Word32 gzipcrctab = array (0,255) (zip [0..255] [
+ src/Data/Hash/MD5.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE Safe #-}++{-# OPTIONS_GHC -fno-warn-missing-methods #-}++{- |+ Module : Data.Hash.MD5+ Copyright : Copyright (C) 2001 Ian Lynagh+ SPDX-License-Identifier: BSD-3-Clause OR GPL-2.0-or-later++ Maintainer : Ian Lynagh <igloo@earth.li>+ Stability : provisional+ Portability: portable++Generation of MD5sums++Written by Ian Lynagh, igloo\@earth.li+-}++module Data.Hash.MD5+ ( md5+ , md5s+ , md5i+ , MD5(..)+ , ABCD(..)+ , Zord64+ , Str(..)+ , BoolList(..)+ , WordList(..)+ ) where++import Data.Bits+import Data.Char (chr, ord)+import Data.Word++-- | Synonym for 'Word64' due to historic reasons+type Zord64 = Word64++-- ======================== TYPES AND CLASS DEFINTIONS ========================++type XYZ = (Word32, Word32, Word32)+type Rotation = Int+newtype ABCD = ABCD (Word32, Word32, Word32, Word32) deriving (Eq, Show)+newtype Str = Str String+newtype BoolList = BoolList [Bool]+newtype WordList = WordList ([Word32], Zord64)++-- | Anything we want to work out the MD5 of must be an instance of class MD5+class MD5 a where+ get_next :: a -> ([Word32], Int, a) -- get the next blocks worth+ -- \ \ \------ the rest of the input+ -- \ \--------- the number of bits returned+ -- \--------------- the bits returned in 32bit words+ len_pad :: Zord64 -> a -> a -- append the padding and length+ finished :: a -> Bool -- Have we run out of input yet?+++-- Mainly exists because it's fairly easy to do MD5s on input where the+-- length is not a multiple of 8++instance MD5 BoolList where+ get_next (BoolList s) = (bools_to_word32s ys, length ys, BoolList zs)+ where (ys, zs) = splitAt 512 s+ len_pad l (BoolList bs)+ = BoolList (bs ++ [True]+ ++ replicate (fromIntegral $ (447 - l) .&. 511) False+ ++ [l .&. (shiftL 1 x) > 0 | x <- (mangle [0..63])]+ )+ where mangle [] = []+ mangle xs = reverse ys ++ mangle zs+ where (ys, zs) = splitAt 8 xs+ finished (BoolList s) = s == []+++-- The string instance is fairly straightforward++instance MD5 Str where+ get_next (Str s) = (string_to_word32s ys, 8 * length ys, Str zs)+ where (ys, zs) = splitAt 64 s+ len_pad c64 (Str s) = Str (s ++ padding ++ l)+ where padding = '\128':replicate (fromIntegral zeros) '\000'+ zeros = shiftR ((440 - c64) .&. 511) 3+ l = length_to_chars 8 c64+ finished (Str s) = s == ""+++-- YA instance that is believed will be useful++instance MD5 WordList where+ get_next (WordList (ws, l)) = (xs, fromIntegral taken, WordList (ys, l - taken))+ where (xs, ys) = splitAt 16 ws+ taken = if l > 511 then 512 else l .&. 511+ len_pad c64 (WordList (ws, l)) = WordList (beginning ++ nextish ++ blanks ++ size, newlen)+ where beginning = if length ws > 0 then start ++ lastone' else []+ start = init ws+ lastone = last ws+ offset = c64 .&. 31+ lastone' = [if offset > 0 then lastone + theone else lastone]+ theone = shiftL (shiftR 128 (fromIntegral $ offset .&. 7))+ (fromIntegral $ offset .&. (31 - 7))+ nextish = if offset == 0 then [128] else []+ c64' = c64 + (32 - offset)+ num_blanks = (fromIntegral $ shiftR ((448 - c64') .&. 511) 5)+ blanks = replicate num_blanks 0+ lowsize = fromIntegral $ c64 .&. (shiftL 1 32 - 1)+ topsize = fromIntegral $ shiftR c64 32+ size = [lowsize, topsize]+ newlen = l .&. (complement 511)+ + if c64 .&. 511 >= 448 then 1024 else 512+ finished (WordList (_, z)) = z == 0++-- | __WARNING__: This instance only defines the '+' operation+instance Num ABCD where+ ABCD (a1, b1, c1, d1) + ABCD (a2, b2, c2, d2) = ABCD (a1 + a2, b1 + b2, c1 + c2, d1 + d2)++-- ======================== EXPORTED FUNCTIONS ========================+++{- | The simplest function, gives you the MD5 of a string as 4-tuple of+32bit words. -}+md5 :: (MD5 a) => a -> ABCD+md5 m = md5_main False 0 magic_numbers m+++{- | Returns a hex number ala the md5sum program. -}+md5s :: (MD5 a) => a -> String+md5s = abcd_to_string . md5+++{- | Returns an integer equivalent to hex number from 'md5s'. -}+md5i :: (MD5 a) => a -> Integer+md5i = abcd_to_integer . md5+++-- ======================== THE CORE ALGORITHM ========================+++-- Decides what to do. The first argument indicates if padding has been+-- added. The second is the length mod 2^64 so far. Then we have the+-- starting state, the rest of the string and the final state.++md5_main :: (MD5 a) =>+ Bool -- Have we added padding yet?+ -> Zord64 -- The length so far mod 2^64+ -> ABCD -- The initial state+ -> a -- The non-processed portion of the message+ -> ABCD -- The resulting state+md5_main padded ilen abcd m+ = if finished m && padded+ then abcd+ else md5_main padded' (ilen + 512) (abcd + abcd') m''+ where (m16, l, m') = get_next m+ len' = ilen + fromIntegral l+ ((m16', _, m''), padded') = if not padded && l < 512+ then (get_next $ len_pad len' m, True)+ else ((m16, l, m'), padded)+ abcd' = md5_do_block abcd m16'+++-- md5_do_block processes a 512 bit block by calling md5_round 4 times to+-- apply each round with the correct constants and permutations of the+-- block++md5_do_block :: ABCD -- Initial state+ -> [Word32] -- The block to be processed - 16 32bit words+ -> ABCD -- Resulting state+md5_do_block abcd0 w = abcd4+ where (r1, r2, r3, r4) = rounds+ {-+ map (\x -> w !! x) [1,6,11,0,5,10,15,4,9,14,3,8,13,2,7,12]+ -- [(5 * x + 1) `mod` 16 | x <- [0..15]]+ map (\x -> w !! x) [5,8,11,14,1,4,7,10,13,0,3,6,9,12,15,2]+ -- [(3 * x + 5) `mod` 16 | x <- [0..15]]+ map (\x -> w !! x) [0,7,14,5,12,3,10,1,8,15,6,13,4,11,2,9]+ -- [(7 * x) `mod` 16 | x <- [0..15]]+ -}+ perm5 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]+ = [c1,c6,c11,c0,c5,c10,c15,c4,c9,c14,c3,c8,c13,c2,c7,c12]+ perm5 _ = error "broke at perm5"+ perm3 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]+ = [c5,c8,c11,c14,c1,c4,c7,c10,c13,c0,c3,c6,c9,c12,c15,c2]+ perm3 _ = error "broke at perm3"+ perm7 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]+ = [c0,c7,c14,c5,c12,c3,c10,c1,c8,c15,c6,c13,c4,c11,c2,c9]+ perm7 _ = error "broke at perm7"+ abcd1 = md5_round md5_f abcd0 w r1+ abcd2 = md5_round md5_g abcd1 (perm5 w) r2+ abcd3 = md5_round md5_h abcd2 (perm3 w) r3+ abcd4 = md5_round md5_i abcd3 (perm7 w) r4+++-- md5_round does one of the rounds. It takes an auxiliary function and foldls+-- (md5_inner_function f) to repeatedly apply it to the initial state with the+-- correct constants++md5_round :: (XYZ -> Word32) -- Auxiliary function (F, G, H or I+ -- for those of you with a copy of+ -- the prayer book^W^WRFC)+ -> ABCD -- Initial state+ -> [Word32] -- The 16 32bit words of input+ -> [(Rotation, Word32)] -- The list of 16 rotations and+ -- additive constants+ -> ABCD -- Resulting state+md5_round f abcd s ns = foldl (md5_inner_function f) abcd ns'+ where ns' = zipWith (\x (y, z) -> (y, x + z)) s ns+++-- Apply one of the functions md5_[fghi] and put the new ABCD together++md5_inner_function :: (XYZ -> Word32) -- Auxiliary function+ -> ABCD -- Initial state+ -> (Rotation, Word32) -- The rotation and additive+ -- constant (X[i] + T[j])+ -> ABCD -- Resulting state+md5_inner_function f (ABCD (a, b, c, d)) (s, ki) = ABCD (d, a', b, c)+ where mid_a = a + f(b,c,d) + ki+ rot_a = rotateL mid_a s+ a' = b + rot_a++-- The 4 auxiliary functions++md5_f :: XYZ -> Word32+md5_f (x, y, z) = z `xor` (x .&. (y `xor` z))+{- optimised version of: (x .&. y) .|. ((complement x) .&. z) -}++md5_g :: XYZ -> Word32+md5_g (x, y, z) = md5_f (z, x, y)+{- was: (x .&. z) .|. (y .&. (complement z)) -}++md5_h :: XYZ -> Word32+md5_h (x, y, z) = x `xor` y `xor` z++md5_i :: XYZ -> Word32+md5_i (x, y, z) = y `xor` (x .|. (complement z))+++-- The magic numbers from the RFC.++magic_numbers :: ABCD+magic_numbers = ABCD (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476)+++-- The 4 lists of (rotation, additive constant) tuples, one for each round++rounds :: ([(Rotation, Word32)],+ [(Rotation, Word32)],+ [(Rotation, Word32)],+ [(Rotation, Word32)])+rounds = (r1, r2, r3, r4)+ where r1 = [(s11, 0xd76aa478), (s12, 0xe8c7b756), (s13, 0x242070db),+ (s14, 0xc1bdceee), (s11, 0xf57c0faf), (s12, 0x4787c62a),+ (s13, 0xa8304613), (s14, 0xfd469501), (s11, 0x698098d8),+ (s12, 0x8b44f7af), (s13, 0xffff5bb1), (s14, 0x895cd7be),+ (s11, 0x6b901122), (s12, 0xfd987193), (s13, 0xa679438e),+ (s14, 0x49b40821)]+ r2 = [(s21, 0xf61e2562), (s22, 0xc040b340), (s23, 0x265e5a51),+ (s24, 0xe9b6c7aa), (s21, 0xd62f105d), (s22, 0x2441453),+ (s23, 0xd8a1e681), (s24, 0xe7d3fbc8), (s21, 0x21e1cde6),+ (s22, 0xc33707d6), (s23, 0xf4d50d87), (s24, 0x455a14ed),+ (s21, 0xa9e3e905), (s22, 0xfcefa3f8), (s23, 0x676f02d9),+ (s24, 0x8d2a4c8a)]+ r3 = [(s31, 0xfffa3942), (s32, 0x8771f681), (s33, 0x6d9d6122),+ (s34, 0xfde5380c), (s31, 0xa4beea44), (s32, 0x4bdecfa9),+ (s33, 0xf6bb4b60), (s34, 0xbebfbc70), (s31, 0x289b7ec6),+ (s32, 0xeaa127fa), (s33, 0xd4ef3085), (s34, 0x4881d05),+ (s31, 0xd9d4d039), (s32, 0xe6db99e5), (s33, 0x1fa27cf8),+ (s34, 0xc4ac5665)]+ r4 = [(s41, 0xf4292244), (s42, 0x432aff97), (s43, 0xab9423a7),+ (s44, 0xfc93a039), (s41, 0x655b59c3), (s42, 0x8f0ccc92),+ (s43, 0xffeff47d), (s44, 0x85845dd1), (s41, 0x6fa87e4f),+ (s42, 0xfe2ce6e0), (s43, 0xa3014314), (s44, 0x4e0811a1),+ (s41, 0xf7537e82), (s42, 0xbd3af235), (s43, 0x2ad7d2bb),+ (s44, 0xeb86d391)]+ s11 = 7+ s12 = 12+ s13 = 17+ s14 = 22+ s21 = 5+ s22 = 9+ s23 = 14+ s24 = 20+ s31 = 4+ s32 = 11+ s33 = 16+ s34 = 23+ s41 = 6+ s42 = 10+ s43 = 15+ s44 = 21+++-- ======================== CONVERSION FUNCTIONS ========================+++-- Turn the 4 32 bit words into a string representing the hex number they+-- represent.++abcd_to_string :: ABCD -> String+abcd_to_string (ABCD (a,b,c,d)) = concat $ map display_32bits_as_hex [a,b,c,d]+++-- Split the 32 bit word up, swap the chunks over and convert the numbers+-- to their hex equivalents.++display_32bits_as_hex :: Word32 -> String+display_32bits_as_hex w = swap_pairs cs+ where cs = map (\x -> getc $ (shiftR w (4*x)) .&. 15) [0..7]+ getc n = (['0'..'9'] ++ ['a'..'f']) !! (fromIntegral n)+ swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs+ swap_pairs _ = []++-- Convert to an integer, performing endianness magic as we go++abcd_to_integer :: ABCD -> Integer+abcd_to_integer (ABCD (a,b,c,d)) = rev_num a * 2^(96 :: Int)+ + rev_num b * 2^(64 :: Int)+ + rev_num c * 2^(32 :: Int)+ + rev_num d++rev_num :: Word32 -> Integer+rev_num i = toInteger j `mod` (2^(32 :: Int))+ -- NHC's fault ~~~~~~~~~~~~~~~~~~~~~+ where j = foldl (\so_far next -> shiftL so_far 8 + (shiftR i next .&. 255))+ 0 [0,8,16,24]++-- Used to convert a 64 byte string to 16 32bit words++string_to_word32s :: String -> [Word32]+string_to_word32s "" = []+string_to_word32s ss = this:string_to_word32s ss'+ where (s, ss') = splitAt 4 ss+ this = foldr (\c w -> shiftL w 8 + (fromIntegral.ord) c) 0 s+++-- Used to convert a list of 512 bools to 16 32bit words++bools_to_word32s :: [Bool] -> [Word32]+bools_to_word32s [] = []+bools_to_word32s bs = this:bools_to_word32s rest+ where (bs1, bs1') = splitAt 8 bs+ (bs2, bs2') = splitAt 8 bs1'+ (bs3, bs3') = splitAt 8 bs2'+ (bs4, rest) = splitAt 8 bs3'+ this = boolss_to_word32 [bs1, bs2, bs3, bs4]+ bools_to_word8 = foldl (\w b -> shiftL w 1 + if b then 1 else 0) 0+ boolss_to_word32 = foldr (\w8 w -> shiftL w 8 + bools_to_word8 w8) 0+++-- Convert the size into a list of characters used by the len_pad function+-- for strings++length_to_chars :: Int -> Zord64 -> String+length_to_chars 0 _ = []+length_to_chars p n = this:length_to_chars (p-1) (shiftR n 8)+ where this = chr $ fromIntegral $ n .&. 255
− src/Data/Hash/MD5.lhs
@@ -1,359 +0,0 @@->{- |-> Module : Data.Hash.MD5-> Copyright : Copyright (C) 2001 Ian Lynagh -> License : Either BSD or GPL->-> Maintainer : Ian Lynagh <igloo@earth.li>-> Stability : provisional-> Portability: portable->->Generation of MD5sums->->Written by Ian Lynagh, igloo\@earth.li->-}--> module Data.Hash.MD5 (md5, md5s, md5i,-> MD5(..), ABCD(..), Zord64, Str(..), BoolList(..), WordList(..)) where--> import Data.Char-> import Data.Bits-> import Data.Word---Nasty kludge to create a type Zord64 which is really a Word64 but works-how we want in hugs ands nhc98 too...-Also need a rotate left function that actually works.--#ifdef __GLASGOW_HASKELL__-#define rotL rotateL-> type Zord64 = Word64-#else--> import Data.Hash.MD5.Zord64_HARD- -> rotL :: Word32 -> Rotation -> Word32-> rotL a s = shiftL a s .|. shiftL a (s-32)--#endif--======================== TYPES AND CLASS DEFINTIONS ========================---> type XYZ = (Word32, Word32, Word32)-> type Rotation = Int-> newtype ABCD = ABCD (Word32, Word32, Word32, Word32) deriving (Eq, Show)-> newtype Str = Str String-> newtype BoolList = BoolList [Bool]-> newtype WordList = WordList ([Word32], Zord64)--> -- | Anything we want to work out the MD5 of must be an instance of class MD5-> class MD5 a where-> get_next :: a -> ([Word32], Int, a) -- get the next blocks worth-> -- \ \ \------ the rest of the input-> -- \ \--------- the number of bits returned-> -- \--------------- the bits returned in 32bit words-> len_pad :: Zord64 -> a -> a -- append the padding and length-> finished :: a -> Bool -- Have we run out of input yet?---Mainly exists because it's fairly easy to do MD5s on input where the-length is not a multiple of 8--> instance MD5 BoolList where-> get_next (BoolList s) = (bools_to_word32s ys, length ys, BoolList zs)-> where (ys, zs) = splitAt 512 s-> len_pad l (BoolList bs)-> = BoolList (bs ++ [True]-> ++ replicate (fromIntegral $ (447 - l) .&. 511) False-> ++ [l .&. (shiftL 1 x) > 0 | x <- (mangle [0..63])]-> )-> where mangle [] = []-> mangle xs = reverse ys ++ mangle zs-> where (ys, zs) = splitAt 8 xs-> finished (BoolList s) = s == []---The string instance is fairly straightforward--> instance MD5 Str where-> get_next (Str s) = (string_to_word32s ys, 8 * length ys, Str zs)-> where (ys, zs) = splitAt 64 s-> len_pad c64 (Str s) = Str (s ++ padding ++ l)-> where padding = '\128':replicate (fromIntegral zeros) '\000'-> zeros = shiftR ((440 - c64) .&. 511) 3-> l = length_to_chars 8 c64-> finished (Str s) = s == ""---YA instance that is believed will be useful--> instance MD5 WordList where-> get_next (WordList (ws, l)) = (xs, fromIntegral taken, WordList (ys, l - taken))-> where (xs, ys) = splitAt 16 ws-> taken = if l > 511 then 512 else l .&. 511-> len_pad c64 (WordList (ws, l)) = WordList (beginning ++ nextish ++ blanks ++ size, newlen)-> where beginning = if length ws > 0 then start ++ lastone' else []-> start = init ws-> lastone = last ws-> offset = c64 .&. 31-> lastone' = [if offset > 0 then lastone + theone else lastone]-> theone = shiftL (shiftR 128 (fromIntegral $ offset .&. 7))-> (fromIntegral $ offset .&. (31 - 7))-> nextish = if offset == 0 then [128] else []-> c64' = c64 + (32 - offset)-> num_blanks = (fromIntegral $ shiftR ((448 - c64') .&. 511) 5)-> blanks = replicate num_blanks 0-> lowsize = fromIntegral $ c64 .&. (shiftL 1 32 - 1)-> topsize = fromIntegral $ shiftR c64 32-> size = [lowsize, topsize]-> newlen = l .&. (complement 511)-> + if c64 .&. 511 >= 448 then 1024 else 512-> finished (WordList (_, z)) = z == 0---> instance Num ABCD where-> ABCD (a1, b1, c1, d1) + ABCD (a2, b2, c2, d2) = ABCD (a1 + a2, b1 + b2, c1 + c2, d1 + d2)---======================== EXPORTED FUNCTIONS ========================---> {- | The simplest function, gives you the MD5 of a string as 4-tuple of-> 32bit words. -}-> md5 :: (MD5 a) => a -> ABCD-> md5 m = md5_main False 0 magic_numbers m---> {- | Returns a hex number ala the md5sum program. -}-> md5s :: (MD5 a) => a -> String-> md5s = abcd_to_string . md5---> {- | Returns an integer equivalent to hex number from 'md5s'. -}-> md5i :: (MD5 a) => a -> Integer-> md5i = abcd_to_integer . md5---======================== THE CORE ALGORITHM ========================---Decides what to do. The first argument indicates if padding has been-added. The second is the length mod 2^64 so far. Then we have the-starting state, the rest of the string and the final state.--> md5_main :: (MD5 a) =>-> Bool -- Have we added padding yet?-> -> Zord64 -- The length so far mod 2^64-> -> ABCD -- The initial state-> -> a -- The non-processed portion of the message-> -> ABCD -- The resulting state-> md5_main padded ilen abcd m-> = if finished m && padded-> then abcd-> else md5_main padded' (ilen + 512) (abcd + abcd') m''-> where (m16, l, m') = get_next m-> len' = ilen + fromIntegral l-> ((m16', _, m''), padded') = if not padded && l < 512-> then (get_next $ len_pad len' m, True)-> else ((m16, l, m'), padded)-> abcd' = md5_do_block abcd m16'---md5_do_block processes a 512 bit block by calling md5_round 4 times to-apply each round with the correct constants and permutations of the-block--> md5_do_block :: ABCD -- Initial state-> -> [Word32] -- The block to be processed - 16 32bit words-> -> ABCD -- Resulting state-> md5_do_block abcd0 w = abcd4-> where (r1, r2, r3, r4) = rounds-> {--> map (\x -> w !! x) [1,6,11,0,5,10,15,4,9,14,3,8,13,2,7,12]-> -- [(5 * x + 1) `mod` 16 | x <- [0..15]]-> map (\x -> w !! x) [5,8,11,14,1,4,7,10,13,0,3,6,9,12,15,2]-> -- [(3 * x + 5) `mod` 16 | x <- [0..15]]-> map (\x -> w !! x) [0,7,14,5,12,3,10,1,8,15,6,13,4,11,2,9]-> -- [(7 * x) `mod` 16 | x <- [0..15]]-> -}-> perm5 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]-> = [c1,c6,c11,c0,c5,c10,c15,c4,c9,c14,c3,c8,c13,c2,c7,c12]-> perm5 _ = error "broke at perm5"-> perm3 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]-> = [c5,c8,c11,c14,c1,c4,c7,c10,c13,c0,c3,c6,c9,c12,c15,c2]-> perm3 _ = error "broke at perm3"-> perm7 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15]-> = [c0,c7,c14,c5,c12,c3,c10,c1,c8,c15,c6,c13,c4,c11,c2,c9]-> perm7 _ = error "broke at perm7"-> abcd1 = md5_round md5_f abcd0 w r1-> abcd2 = md5_round md5_g abcd1 (perm5 w) r2-> abcd3 = md5_round md5_h abcd2 (perm3 w) r3-> abcd4 = md5_round md5_i abcd3 (perm7 w) r4---md5_round does one of the rounds. It takes an auxiliary function and foldls-(md5_inner_function f) to repeatedly apply it to the initial state with the-correct constants--> md5_round :: (XYZ -> Word32) -- Auxiliary function (F, G, H or I-> -- for those of you with a copy of-> -- the prayer book^W^WRFC)-> -> ABCD -- Initial state-> -> [Word32] -- The 16 32bit words of input-> -> [(Rotation, Word32)] -- The list of 16 rotations and-> -- additive constants-> -> ABCD -- Resulting state-> md5_round f abcd s ns = foldl (md5_inner_function f) abcd ns'-> where ns' = zipWith (\x (y, z) -> (y, x + z)) s ns---Apply one of the functions md5_[fghi] and put the new ABCD together--> md5_inner_function :: (XYZ -> Word32) -- Auxiliary function-> -> ABCD -- Initial state-> -> (Rotation, Word32) -- The rotation and additive-> -- constant (X[i] + T[j])-> -> ABCD -- Resulting state-> md5_inner_function f (ABCD (a, b, c, d)) (s, ki) = ABCD (d, a', b, c)-> where mid_a = a + f(b,c,d) + ki-> rot_a = rotL mid_a s-> a' = b + rot_a---The 4 auxiliary functions--> md5_f :: XYZ -> Word32-> md5_f (x, y, z) = z `xor` (x .&. (y `xor` z))-> {- optimised version of: (x .&. y) .|. ((complement x) .&. z) -}--> md5_g :: XYZ -> Word32-> md5_g (x, y, z) = md5_f (z, x, y)-> {- was: (x .&. z) .|. (y .&. (complement z)) -}--> md5_h :: XYZ -> Word32-> md5_h (x, y, z) = x `xor` y `xor` z--> md5_i :: XYZ -> Word32-> md5_i (x, y, z) = y `xor` (x .|. (complement z))---The magic numbers from the RFC.--> magic_numbers :: ABCD-> magic_numbers = ABCD (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476)---The 4 lists of (rotation, additive constant) tuples, one for each round--> rounds :: ([(Rotation, Word32)],-> [(Rotation, Word32)],-> [(Rotation, Word32)],-> [(Rotation, Word32)])-> rounds = (r1, r2, r3, r4)-> where r1 = [(s11, 0xd76aa478), (s12, 0xe8c7b756), (s13, 0x242070db),-> (s14, 0xc1bdceee), (s11, 0xf57c0faf), (s12, 0x4787c62a),-> (s13, 0xa8304613), (s14, 0xfd469501), (s11, 0x698098d8),-> (s12, 0x8b44f7af), (s13, 0xffff5bb1), (s14, 0x895cd7be),-> (s11, 0x6b901122), (s12, 0xfd987193), (s13, 0xa679438e),-> (s14, 0x49b40821)]-> r2 = [(s21, 0xf61e2562), (s22, 0xc040b340), (s23, 0x265e5a51),-> (s24, 0xe9b6c7aa), (s21, 0xd62f105d), (s22, 0x2441453),-> (s23, 0xd8a1e681), (s24, 0xe7d3fbc8), (s21, 0x21e1cde6),-> (s22, 0xc33707d6), (s23, 0xf4d50d87), (s24, 0x455a14ed),-> (s21, 0xa9e3e905), (s22, 0xfcefa3f8), (s23, 0x676f02d9),-> (s24, 0x8d2a4c8a)]-> r3 = [(s31, 0xfffa3942), (s32, 0x8771f681), (s33, 0x6d9d6122),-> (s34, 0xfde5380c), (s31, 0xa4beea44), (s32, 0x4bdecfa9),-> (s33, 0xf6bb4b60), (s34, 0xbebfbc70), (s31, 0x289b7ec6),-> (s32, 0xeaa127fa), (s33, 0xd4ef3085), (s34, 0x4881d05),-> (s31, 0xd9d4d039), (s32, 0xe6db99e5), (s33, 0x1fa27cf8),-> (s34, 0xc4ac5665)]-> r4 = [(s41, 0xf4292244), (s42, 0x432aff97), (s43, 0xab9423a7),-> (s44, 0xfc93a039), (s41, 0x655b59c3), (s42, 0x8f0ccc92),-> (s43, 0xffeff47d), (s44, 0x85845dd1), (s41, 0x6fa87e4f),-> (s42, 0xfe2ce6e0), (s43, 0xa3014314), (s44, 0x4e0811a1),-> (s41, 0xf7537e82), (s42, 0xbd3af235), (s43, 0x2ad7d2bb),-> (s44, 0xeb86d391)]-> s11 = 7-> s12 = 12-> s13 = 17-> s14 = 22-> s21 = 5-> s22 = 9-> s23 = 14-> s24 = 20-> s31 = 4-> s32 = 11-> s33 = 16-> s34 = 23-> s41 = 6-> s42 = 10-> s43 = 15-> s44 = 21---======================== CONVERSION FUNCTIONS ========================---Turn the 4 32 bit words into a string representing the hex number they-represent.--> abcd_to_string :: ABCD -> String-> abcd_to_string (ABCD (a,b,c,d)) = concat $ map display_32bits_as_hex [a,b,c,d]---Split the 32 bit word up, swap the chunks over and convert the numbers-to their hex equivalents.--> display_32bits_as_hex :: Word32 -> String-> display_32bits_as_hex w = swap_pairs cs-> where cs = map (\x -> getc $ (shiftR w (4*x)) .&. 15) [0..7]-> getc n = (['0'..'9'] ++ ['a'..'f']) !! (fromIntegral n)-> swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs-> swap_pairs _ = []--Convert to an integer, performing endianness magic as we go--> abcd_to_integer :: ABCD -> Integer-> abcd_to_integer (ABCD (a,b,c,d)) = rev_num a * 2^(96 :: Int)-> + rev_num b * 2^(64 :: Int)-> + rev_num c * 2^(32 :: Int)-> + rev_num d--> rev_num :: Word32 -> Integer-> rev_num i = toInteger j `mod` (2^(32 :: Int))-> -- NHC's fault ~~~~~~~~~~~~~~~~~~~~~-> where j = foldl (\so_far next -> shiftL so_far 8 + (shiftR i next .&. 255))-> 0 [0,8,16,24]--Used to convert a 64 byte string to 16 32bit words--> string_to_word32s :: String -> [Word32]-> string_to_word32s "" = []-> string_to_word32s ss = this:string_to_word32s ss'-> where (s, ss') = splitAt 4 ss-> this = foldr (\c w -> shiftL w 8 + (fromIntegral.ord) c) 0 s---Used to convert a list of 512 bools to 16 32bit words--> bools_to_word32s :: [Bool] -> [Word32]-> bools_to_word32s [] = []-> bools_to_word32s bs = this:bools_to_word32s rest-> where (bs1, bs1') = splitAt 8 bs-> (bs2, bs2') = splitAt 8 bs1'-> (bs3, bs3') = splitAt 8 bs2'-> (bs4, rest) = splitAt 8 bs3'-> this = boolss_to_word32 [bs1, bs2, bs3, bs4]-> bools_to_word8 = foldl (\w b -> shiftL w 1 + if b then 1 else 0) 0-> boolss_to_word32 = foldr (\w8 w -> shiftL w 8 + bools_to_word8 w8) 0---Convert the size into a list of characters used by the len_pad function-for strings--> length_to_chars :: Int -> Zord64 -> String-> length_to_chars 0 _ = []-> length_to_chars p n = this:length_to_chars (p-1) (shiftR n 8)-> where this = chr $ fromIntegral $ n .&. 255-
+ src/Data/Hash/MD5/Zord64_HARD.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE Safe #-}++{-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}++-- | Obsolete legacy module+module Data.Hash.MD5.Zord64_HARD (Zord64) where++import Data.Bits+import Data.Word++data Zord64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)++w64ToInteger W64{lo=lo,hi=hi} = toInteger lo + 0x100000000 * toInteger hi+integerToW64 x = case x `quotRem` 0x100000000 of+ (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}++instance Show Zord64++instance Read Zord64++instance Num Zord64 where+ W64{lo=lo_a,hi=hi_a} + W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}+ where lo' = lo_a + lo_b+ hi' = hi_a + hi_b + if lo' < lo_a then 1 else 0+ W64{lo=lo_a,hi=hi_a} - W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}+ where lo' = lo_a - lo_b+ hi' = hi_a - hi_b + if lo' > lo_a then 1 else 0+ fromInteger = integerToW64++instance Bits Zord64 where+ W64{lo=lo_a,hi=hi_a} .&. W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}+ where lo' = lo_a .&. lo_b+ hi' = hi_a .&. hi_b+ W64{lo=lo_a,hi=hi_a} .|. W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}+ where lo' = lo_a .|. lo_b+ hi' = hi_a .|. hi_b+ shift w 0 = w+ shift W64{lo=lo,hi=hi} x+ | x > 63 = W64{lo=0,hi=0}+ | x > 31 = W64{lo = 0, hi = shift lo (x-32)}+ | x > 0 = W64{lo = shift lo x, hi = shift hi x .|. shift lo (x-32)}+ | x < -63 = W64{lo=0,hi=0}+ | x < -31 = W64{lo = shift hi (x+32), hi = 0}+ | x < 0 = W64{lo = shift lo x .|. shift hi (x+32), hi = shift hi x}+ complement W64{lo=lo,hi=hi} = W64{lo=complement lo,hi=complement hi}++instance Integral Zord64 where+ toInteger = w64ToInteger++instance Real Zord64+instance Enum Zord64+
− src/Data/Hash/MD5/Zord64_HARD.lhs
@@ -1,48 +0,0 @@->-- #hide-> module Data.Hash.MD5.Zord64_HARD (Zord64) where--> import Data.Word-> import Data.Bits--> data Zord64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)--> w64ToInteger W64{lo=lo,hi=hi} = toInteger lo + 0x100000000 * toInteger hi-> integerToW64 x = case x `quotRem` 0x100000000 of-> (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}--> instance Show Zord64--> instance Read Zord64--> instance Num Zord64 where-> W64{lo=lo_a,hi=hi_a} + W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}-> where lo' = lo_a + lo_b-> hi' = hi_a + hi_b + if lo' < lo_a then 1 else 0-> W64{lo=lo_a,hi=hi_a} - W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}-> where lo' = lo_a - lo_b-> hi' = hi_a - hi_b + if lo' > lo_a then 1 else 0-> fromInteger = integerToW64--> instance Bits Zord64 where-> W64{lo=lo_a,hi=hi_a} .&. W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}-> where lo' = lo_a .&. lo_b-> hi' = hi_a .&. hi_b-> W64{lo=lo_a,hi=hi_a} .|. W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'}-> where lo' = lo_a .|. lo_b-> hi' = hi_a .|. hi_b-> shift w 0 = w-> shift W64{lo=lo,hi=hi} x-> | x > 63 = W64{lo=0,hi=0}-> | x > 31 = W64{lo = 0, hi = shift lo (x-32)}-> | x > 0 = W64{lo = shift lo x, hi = shift hi x .|. shift lo (x-32)}-> | x < -63 = W64{lo=0,hi=0}-> | x < -31 = W64{lo = shift hi (x+32), hi = 0}-> | x < 0 = W64{lo = shift lo x .|. shift hi (x+32), hi = shift hi x}-> complement W64{lo=lo,hi=hi} = W64{lo=complement lo,hi=complement hi}--> instance Integral Zord64 where-> toInteger = w64ToInteger--> instance Real Zord64-> instance Enum Zord64-
src/Data/List/Utils.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.List.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -49,10 +48,12 @@ -- -- * Sub-List Selection -- sub, ) where-import Data.List(intersperse, concat, isPrefixOf, isSuffixOf, elemIndices,- elemIndex, elemIndices, tails, find, findIndex, isInfixOf, nub)-import Control.Monad.State(State, get, put)-import Data.Maybe(isJust)+import Control.Monad.State (State, get, put)+import Data.List (concat, elemIndex, elemIndices,+ elemIndices, find, findIndex, intersperse,+ isInfixOf, isPrefixOf, isSuffixOf, nub,+ tails)+import Data.Maybe (isJust) {- | Merge two sorted lists into a single, sorted whole.@@ -83,7 +84,7 @@ mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] mergeBy cmp [] ys = ys mergeBy cmp xs [] = xs-mergeBy cmp (allx@(x:xs)) (ally@(y:ys)) +mergeBy cmp (allx@(x:xs)) (ally@(y:ys)) -- Ordering derives Eq, Ord, so the comparison below is valid. -- Explanation left as an exercise for the reader. -- Someone please put this code out of its misery.@@ -118,8 +119,8 @@ hasAny :: Eq a => [a] -- ^ List of elements to look for -> [a] -- ^ List to search -> Bool -- ^ Result-hasAny [] _ = False -- An empty search list: always false-hasAny _ [] = False -- An empty list to scan: always false+hasAny [] _ = False -- An empty search list: always false+hasAny _ [] = False -- An empty list to scan: always false hasAny search (x:xs) = if x `elem` search then True else hasAny search xs {- | Similar to Data.List.takeWhile, takes elements while the func is true.@@ -127,7 +128,7 @@ takeWhileList :: ([a] -> Bool) -> [a] -> [a] takeWhileList _ [] = [] takeWhileList func list@(x:xs) =- if func list + if func list then x : takeWhileList func xs else [] @@ -141,9 +142,9 @@ else list {- | Similar to Data.List.span, but performs the test on the entire remaining-list instead of just one element. +list instead of just one element. -@spanList p xs@ is the same as @(takeWhileList p xs, dropWhileList p xs)@ +@spanList p xs@ is the same as @(takeWhileList p xs, dropWhileList p xs)@ -} spanList :: ([a] -> Bool) -> [a] -> ([a], [a]) @@ -172,12 +173,12 @@ split _ [] = [] split delim str = let (firstline, remainder) = breakList (startswith delim) str- in + in firstline : case remainder of [] -> [] x -> if x == delim then [] : []- else split delim + else split delim (drop (length delim) x) @@ -280,7 +281,7 @@ worker ((k, v):xs) accum = case lookup v accum of Nothing -> worker xs ((v, [k]) : accum)- Just y -> worker xs (addToAL accum v (k:y))+ Just y -> worker xs (addToAL accum v (k:y)) in worker oldl [] @@ -296,13 +297,13 @@ in unlines . map worker $ inp {- | The inverse of 'strFromAL', this function reads a string and outputs the-appropriate association list. +appropriate association list. Like 'strFromAL', this is designed to work with [(String, String)] association lists but may also work with other objects with simple representations. -} strToAL :: (Read a, Read b) => String -> [(a, b)]-strToAL inp = +strToAL inp = let worker line = case reads line of [(key, remainder)] -> case remainder of@@ -324,7 +325,7 @@ elemRIndex :: Eq a => a -> [a] -> Maybe Int elemRIndex item l = case reverse $ elemIndices item l of- [] -> Nothing+ [] -> Nothing (x:_) -> Just x {- | Like elemRIndex, but returns -1 if there is nothing found. -}@@ -332,11 +333,11 @@ alwaysElemRIndex item list = case elemRIndex item list of Nothing -> -1- Just x -> x+ Just x -> x {- | Forces the evaluation of the entire list. -} seqList :: [a] -> [a]-seqList [] = []+seqList [] = [] seqList list@(x:xs) = seq (seqList xs) list --------------------------------------------------@@ -347,7 +348,7 @@ -} newtype WholeFunc a b = WholeFunc ([a] -> (WholeFunc a b, [a], [b])) -{- | This is an enhanced version of the concatMap or map functions in +{- | This is an enhanced version of the concatMap or map functions in Data.List. Unlike those functions, this one:@@ -401,7 +402,7 @@ > --> ["Hello",", T","his is"," ","a test."] -} fixedWidth :: [Int] -> WholeFunc a [a]-fixedWidth len = +fixedWidth len = WholeFunc (fixedWidthFunc len) where -- Empty input: Empty output, stop fixedWidthFunc _ [] = ((fixedWidth []), [], [])
src/Data/MIME/Types.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ {- arch-tag: MIME Types main file Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : Data.MIME.Types Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/Data/Map/Utils.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE Safe #-}-{- +{- Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> All rights reserved.@@ -10,9 +10,8 @@ {- | Module : Data.Map.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -29,8 +28,8 @@ ) where +import Data.List.Utils (flipAL, strFromAL, strToAL) import qualified Data.Map-import Data.List.Utils(flipAL, strToAL, strFromAL) {- | Converts a String, String Map into a string representation. See 'Data.List.Utils.strFromAL' for more on the similar function for@@ -71,7 +70,7 @@ flippedLookupM v fm = case Data.Map.lookup v (flipM fm) of Nothing -> []- Just x -> x+ Just x -> x {- | Performs a lookup, and raises an exception (with an error message prepended with the given string) if the key could not be found.@@ -80,5 +79,5 @@ Data.Map.Map key elt -> elt forceLookupM msg k fm = case Data.Map.lookup k fm of- Just x -> x+ Just x -> x Nothing -> error $ msg ++ ": could not find key " ++ (show k)
src/Data/Maybe/Utils.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.Maybe.Utils Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -33,4 +32,4 @@ Nothing is supplied. -} forceMaybeMsg :: String -> Maybe a -> a forceMaybeMsg msg Nothing = error msg-forceMaybeMsg _ (Just x) = x+forceMaybeMsg _ (Just x) = x
src/Data/Progress/Meter.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ {- Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : Data.Progress.Meter Copyright : Copyright (C) 2006-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/Data/Progress/Tracker.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.Progress.Tracker Copyright : Copyright (C) 2006-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/Data/Quantity.hs view
@@ -10,9 +10,8 @@ {- | Module : Data.Quantity Copyright : Copyright (C) 2006-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -33,17 +32,17 @@ ) where-import Data.List-import Text.Printf-import Data.Char+import Data.Char+import Data.List+import Text.Printf {- | The options for 'quantifyNum' and 'renderNum' -}-data SizeOpts = SizeOpts { base :: Int, -- ^ The base from which calculations are made- powerIncr :: Int, -- ^ The increment to the power for each new suffix+data SizeOpts = SizeOpts { base :: Int, -- ^ The base from which calculations are made+ powerIncr :: Int, -- ^ The increment to the power for each new suffix firstPower :: Int, -- ^ The first power for which suffixes are given- suffixes :: String -- ^ The suffixes themselves+ suffixes :: String -- ^ The suffixes themselves }- + {- | Predefined definitions for byte measurement in groups of 1024, from 0 to 2**80 -} binaryOpts :: SizeOpts@@ -80,7 +79,7 @@ incrList = map idx2pwr [0..length (suffixes opts) - 1] incrIdxList = zip incrList [0..] idx2pwr i = i * powerIncr opts + firstPower opts- finderfunc (x, _) = (fromIntegral $ base opts) ** (fromIntegral x) + finderfunc (x, _) = (fromIntegral $ base opts) ** (fromIntegral x) <= (abs number) -- Find the largest item that does not exceed the number given. -- If the number is larger than the larger item in the list,@@ -88,7 +87,7 @@ (usedexp, expidx) = case find finderfunc (reverse incrIdxList) of- Just x -> x+ Just x -> x Nothing -> head incrIdxList -- If not found, it's smaller than the first suffix = (suffixes opts !! (fromIntegral expidx)) procnum n = (fromRational . toRational $ n) /@@ -123,7 +122,7 @@ > "100.00u" If you want more control over the output, see 'quantifyNum'. -}-renderNum :: (Ord a, Real a) => +renderNum :: (Ord a, Real a) => SizeOpts -> Int -- ^ Precision of the result -> a -- ^ The number to examine@@ -157,7 +156,7 @@ map printit convnums where printit num = (printf ("%." ++ show prec ++ "f") num) ++ [suffix]- (convnums, suffix) = + (convnums, suffix) = (quantifyNums opts numbers)::([Double], Char) {- | Parses a String, possibly generated by 'renderNum'. Parses the suffix@@ -168,7 +167,7 @@ If you want an Integral result, the convenience function 'parseNumInt' is for you. -}-parseNum :: (Read a, Fractional a) => +parseNum :: (Read a, Fractional a) => SizeOpts -- ^ Information on how to parse this data -> Bool -- ^ Whether to perform a case-insensitive match -> String -- ^ The string to parse@@ -179,18 +178,18 @@ [(num, "")] -> Right num -- No suffix; pass number unhindered [(num, [suffix])] -> case lookup (caseTransformer suffix) suffixMap of- Nothing -> Left $ "Unrecognized suffix " ++ show suffix+ Nothing -> Left $ "Unrecognized suffix " ++ show suffix Just power -> Right $ num * multiplier power [(_, suffix)] -> Left $ "Multi-character suffix " ++ show suffix _ -> Left "Multiple parses for input"- where suffixMap = zip (map caseTransformer . suffixes $ opts) + where suffixMap = zip (map caseTransformer . suffixes $ opts) (iterate (+ (powerIncr opts)) (firstPower opts)) caseTransformer x | insensitive = toLower x | otherwise = x multiplier :: (Read a, Fractional a) => Int -> a multiplier power =- fromRational . toRational $ + fromRational . toRational $ fromIntegral (base opts) ** fromIntegral power {- | Parse a number as with 'parseNum', but return the result as an 'Integral'. Any type such as Integer, Int, etc. can be used for the@@ -201,12 +200,12 @@ By using this function, a user can still say something like 1.5M and get an integral result. -}-parseNumInt :: (Read a, Integral a) => +parseNumInt :: (Read a, Integral a) => SizeOpts -- ^ Information on how to parse this data -> Bool -- ^ Whether to perform a case-insensitive match -> String -- ^ The string to parse -> Either String a parseNumInt opts insensitive inp = case (parseNum opts insensitive inp)::Either String Double of- Left x -> Left x+ Left x -> Left x Right n -> Right (round n)
src/Data/String/Utils.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Trustworthy #-}+ {- arch-tag: String utilities main file Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : Data.String.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -35,10 +36,10 @@ maybeRead ) where -import Data.List.Utils (startswith, endswith, join, split, replace)-import Data.Char (isAlpha, isAscii, isDigit)-import Data.Maybe (listToMaybe)-import Text.Regex (mkRegex, splitRegex)+import Data.Char (isAlpha, isAscii, isDigit)+import Data.List.Utils (endswith, join, replace, split, startswith)+import Data.Maybe (listToMaybe)+import Text.Regex (mkRegex, splitRegex) wschars :: String wschars = " \t\r\n"
src/Data/Tuple/Utils.hs view
@@ -10,13 +10,12 @@ {- | Module : Data.Tuple.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable -This module provides various helpful utilities for dealing with lists.+This module provides various helpful utilities for dealing with tuples. Written by Neil Mitchell, <http://www.cs.york.ac.uk/~ndm/> -}
src/Network/Email/Mailbox.hs view
@@ -10,9 +10,8 @@ {- | Module : Network.Email.Mailbox Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/Network/Email/Sendmail.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Safe #-}+ {- arch-tag: Sendmail utility Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -10,9 +12,8 @@ {- | Module : Network.Email.Sendmail Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/Network/SocketServer.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Trustworthy #-}+ {- arch-tag: Generic Server Support Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : Network.SocketServer Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : experimental Portability: systems with networking @@ -44,21 +45,21 @@ handleHandler ) where-import Network.Socket-import Network.BSD-import Network.Utils-import Control.Concurrent-import System.IO+import Control.Concurrent+import Network.BSD+import Network.Socket+import Network.Utils+import System.IO import qualified System.Log.Logger {- | Options for your server. -} data InetServerOptions = InetServerOptions {listenQueueSize :: Int,- portNumber :: PortNumber,- interface :: HostAddress,- reuse :: Bool,- family :: Family,- sockType :: SocketType,- protoStr :: String+ portNumber :: PortNumber,+ interface :: HostAddress,+ reuse :: Bool,+ family :: Family,+ sockType :: SocketType,+ protoStr :: String } deriving (Eq, Show) @@ -71,13 +72,13 @@ The third is the address of the local endpoint. -} type HandlerT = Socket -> SockAddr -> SockAddr -> IO ()- + {- | Get Default options. You can always modify it later. -} simpleTCPOptions :: Int -- ^ Port Number -> InetServerOptions simpleTCPOptions p = InetServerOptions {listenQueueSize = 5, portNumber = (fromIntegral p),- interface = iNADDR_ANY,+ interface = 0, reuse = False, family = AF_INET, sockType = Stream,@@ -85,7 +86,7 @@ } data SocketServer = SocketServer {optionsSS :: InetServerOptions,- sockSS :: Socket}+ sockSS :: Socket} deriving (Eq, Show) {- | Takes some options and sets up the 'SocketServer'. I will bind@@ -95,9 +96,9 @@ do proto <- getProtocolNumber (protoStr opts) s <- socket (family opts) (sockType opts) proto setSocketOption s ReuseAddr (case (reuse opts) of- True -> 1+ True -> 1 False -> 0)- bindSocket s (SockAddrInet (portNumber opts)+ bind s (SockAddrInet (portNumber opts) (interface opts)) listen s (listenQueueSize opts) return $ SocketServer {optionsSS = opts, sockSS = s}@@ -106,8 +107,8 @@ handlers, if any. -} closeSocketServer :: SocketServer -> IO () closeSocketServer ss =- sClose (sockSS ss)- + close (sockSS ss)+ {- | Handle one incoming request from the given 'SocketServer'. -} handleOne :: SocketServer -> HandlerT -> IO () handleOne ss func =@@ -115,7 +116,7 @@ in do a <- accept (sockSS ss) localaddr <- getSocketName (fst a) func (fst a) (snd a) localaddr- + {- | Handle all incoming requests from the given 'SocketServer'. -} serveForever :: SocketServer -> HandlerT -> IO () serveForever ss func =@@ -132,7 +133,7 @@ -} serveTCPforever :: InetServerOptions -- ^ Server options -> HandlerT -- ^ Handler function- -> IO () + -> IO () serveTCPforever options func = do sockserv <- setupSocketServer options serveForever sockserv func@@ -152,17 +153,17 @@ -> System.Log.Logger.Priority -- ^ Priority of logged messages -> HandlerT -- ^ Handler to call after logging -> HandlerT -- ^ Resulting handler-loggingHandler hname prio nexth socket r_sockaddr l_sockaddr = +loggingHandler hname prio nexth socket r_sockaddr l_sockaddr = do sockStr <- showSockAddr r_sockaddr- System.Log.Logger.logM hname prio + System.Log.Logger.logM hname prio ("Received connection from " ++ sockStr)- System.Log.Logger.traplogging hname - System.Log.Logger.WARNING "" (nexth socket r_sockaddr + System.Log.Logger.traplogging hname+ System.Log.Logger.WARNING "" (nexth socket r_sockaddr l_sockaddr) System.Log.Logger.logM hname prio ("Connection " ++ sockStr ++ " disconnected")- + -- | Handle each incoming connection in its own thread to -- make the server multi-tasking. threadedHandler :: HandlerT -- ^ Handler to call in the new thread@@ -182,7 +183,7 @@ -} handleHandler :: (Handle -> SockAddr -> SockAddr -> IO ()) -- ^ Handler to call -> HandlerT-handleHandler func socket r_sockaddr l_sockaddr = +handleHandler func socket r_sockaddr l_sockaddr = do h <- socketToHandle socket ReadWriteMode hSetBuffering h LineBuffering func h r_sockaddr l_sockaddr
src/Network/Utils.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}+ {- arch-tag: Network utilities main file Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -8,9 +11,8 @@ {- | Module : Network.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: systems with networking @@ -24,10 +26,9 @@ listenTCPAddr, showSockAddr) where -import Network-import Network.Socket-import Network.BSD-import System.IO+import Network.BSD+import Network.Socket+import System.IO #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) import qualified System.Posix.Signals #endif@@ -70,7 +71,7 @@ listenTCPAddr addr queuelen = do proto <- getProtocolNumber "tcp" s <- socket AF_INET Stream proto- bindSocket s addr+ bind s addr listen s queuelen return s @@ -78,6 +79,6 @@ #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) showSockAddr (SockAddrUnix x) = return $ "UNIX socket at " ++ x #endif-showSockAddr (SockAddrInet port host) =- do h <- inet_ntoa host+showSockAddr sa@(SockAddrInet port host) =+ do (Just h,_) <- getNameInfo [NI_NUMERICHOST] True False sa return $ "IPv4 host " ++ h ++ ", port " ++ (show port)
src/System/Cmd/Utils.hs view
@@ -1,5 +1,7 @@ -- arch-tag: Command utilities main file {-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}+ {- Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -11,9 +13,8 @@ {- | Module : System.Cmd.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable to platforms with POSIX process\/signal tools
src/System/Console/GetOpt/Utils.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE Safe #-}-{- +{- Copyright (c) 2005-2011 John Goerzen <jgoerzen@complete.org> All rights reserved.@@ -10,9 +10,8 @@ {- | Module : MissingH.getOpt Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -28,8 +27,8 @@ stdOptional ) where-import System.Console.GetOpt-import System.Environment+import System.Console.GetOpt+import System.Environment {- | Simple command line parser -- a basic wrapper around the system's default getOpt. See the System.Console.GetOpt manual for a description of the@@ -40,11 +39,11 @@ The return value consists of the list of parsed flags and a list of non-option arguments. -} parseCmdLine :: ArgOrder a -> [OptDescr a] -> String -> IO ([a], [String])-parseCmdLine order options header = +parseCmdLine order options header = do argv <- getArgs case getOpt order options argv of (o, n, []) -> return (o, n)- (_, _, errors) -> ioError (userError (concat errors ++ + (_, _, errors) -> ioError (userError (concat errors ++ usageInfo header options)) {- | Similar to 'parseCmdLine', but takes an additional function that validates@@ -80,5 +79,5 @@ {- | Handle an optional argument. -} stdOptional :: String -- ^ Name of arg -> Maybe String -> StdOption-stdOptional name Nothing = (name, "")+stdOptional name Nothing = (name, "") stdOptional name (Just x) = (name, x)
src/System/Daemon.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}+ {- Copyright (c) 2005-2011 John Goerzen <jgoerzen@complete.org> @@ -10,9 +12,8 @@ {- | Module : System.Daemon Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable to platforms with POSIX process\/signal tools @@ -41,11 +42,11 @@ where #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -import System.Posix.Process-import System.Posix.IO-import System.Directory-import System.Log.Logger-import System.Exit+import System.Directory+import System.Exit+import System.Log.Logger+import System.Posix.IO+import System.Posix.Process trap :: IO a -> IO a
src/System/Debian.hs view
@@ -9,9 +9,8 @@ {- | Module : System.Debian Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -28,9 +27,9 @@ ) where -import System.Process-import System.IO.Unsafe-import System.Exit+import System.Exit+import System.IO.Unsafe (unsafePerformIO)+import System.Process {- | The type representing the contents of a Debian control file, or any control-like file (such as the output from apt-cache show, etc.) -}@@ -41,7 +40,10 @@ ---------------------------------------------------------------------- {- | The type representing a Debian version number. This type is an instance-of 'Prelude.Ord', but you can also use 'compareDebVersion' if you prefer. -}+of 'Prelude.Ord', but you can also use 'compareDebVersion' if you prefer.++__WARNING__: calls out to @dpkg@ and will throw exceptions if @dpkg@ is missing+-} data DebVersion = DebVersion String deriving (Eq) instance Ord DebVersion where@@ -68,5 +70,5 @@ checkDebVersion v1 op v2 = do ec <- rawSystem "dpkg" ["--compare-versions", v1, op, v2] case ec of- ExitSuccess -> return True+ ExitSuccess -> return True ExitFailure _ -> return False
src/System/Debian/ControlParser.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ {- arch-tag: Parser for Debian control file Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : System.Debian.ControlParser Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -24,8 +25,8 @@ module System.Debian.ControlParser(control, depPart) where -import Text.ParserCombinators.Parsec-import Data.String.Utils (split)+import Data.String.Utils (split)+import Text.ParserCombinators.Parsec eol, extline :: GenParser Char st String eol = (try (string "\r\n"))
src/System/FileArchive/GZip.hs view
@@ -10,9 +10,8 @@ {- | Module : System.FileArchive.GZip Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -39,14 +38,14 @@ ) where -import Data.Compression.Inflate (inflate_string_remainder)-import Data.Hash.CRC32.GZip (update_crc)-import Data.Bits ((.&.))-import Control.Monad.Error -- (Error(), strMsg, throwError)-import Data.Char (ord)-import Data.Word (Word32())-import Data.Bits.Utils (fromBytes)-import System.IO (hGetContents, hPutStr, Handle())+import Control.Monad.Error+import Data.Bits ((.&.))+import Data.Bits.Utils (fromBytes)+import Data.Char (ord)+import Data.Compression.Inflate (inflate_string_remainder)+import Data.Hash.CRC32.GZip (update_crc)+import Data.Word (Word32)+import System.IO (Handle, hGetContents, hPutStr) data GZipError = CRCError -- ^ CRC-32 check failed | NotGZIPFile -- ^ Couldn't find a GZip header@@ -73,20 +72,20 @@ {- | The data structure representing the GZip header. This occurs at the beginning of each 'Section' on disk. -} data Header = Header {- method :: Int, -- ^ Compression method. Only 8 is defined at present.- flags :: Int,- extra :: Maybe String,+ method :: Int, -- ^ Compression method. Only 8 is defined at present.+ flags :: Int,+ extra :: Maybe String, filename :: Maybe String,- comment :: Maybe String,- mtime :: Word32, -- ^ Modification time of the original file- xfl :: Int, -- ^ Extra flags- os :: Int -- ^ Creating operating system+ comment :: Maybe String,+ mtime :: Word32, -- ^ Modification time of the original file+ xfl :: Int, -- ^ Extra flags+ os :: Int -- ^ Creating operating system } deriving (Eq, Show) {- | Stored on-disk at the end of each section. -} data Footer = Footer {- size :: Word32, -- ^ The size of the original, decompressed data- crc32 :: Word32, -- ^ The stored GZip CRC-32 of the original, decompressed data+ size :: Word32, -- ^ The size of the original, decompressed data+ crc32 :: Word32, -- ^ The stored GZip CRC-32 of the original, decompressed data crc32valid :: Bool -- ^ Whether or not the stored CRC-32 matches the calculated CRC-32 of the data }
src/System/IO/Binary.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Trustworthy #-}+ {- arch-tag: I/O utilities, binary tools Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : System.IO.Binary Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable to platforms supporting binary I\/O
src/System/IO/HVFS.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, ScopedTypeVariables, TypeSynonymInstances #-}+{-# LANGUAGE CPP, TypeSynonymInstances #-}+{-# LANGUAGE Trustworthy #-} {- arch-tag: HVFS main file Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -10,9 +11,8 @@ {- | Module : System.IO.HVFS Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/System/IO/HVFS/Combinators.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Safe #-} {- arch-tag: HVFS Combinators Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +10,8 @@ {- | Module : System.IO.HVFS.Combinators Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -26,17 +26,18 @@ HVFSChroot, newHVFSChroot) where -import System.IO-import System.IO.Error-import System.IO.HVFS-import System.IO.HVFS.InstanceHelpers (getFullPath)+import System.IO+import System.IO.Error+import System.IO.HVFS+import System.IO.HVFS.InstanceHelpers (getFullPath) #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))-import System.Posix.Files -- This actually needed? -Wall doesn't seem to think+import System.Posix.Files -- so, but I'm not sure... #endif-import System.Path (secureAbsNormPath)-import System.Path.NameManip (normalise_path)-import System.FilePath ((</>), pathSeparator, isPathSeparator)+import System.FilePath (isPathSeparator, pathSeparator,+ (</>))+import System.Path (secureAbsNormPath)+import System.Path.NameManip (normalise_path) ---------------------------------------------------------------------- -- Providing read-only access@@ -79,7 +80,7 @@ instance HVFSOpenable a => HVFSOpenable (HVFSReadOnly a) where vOpen fh fp mode = case mode of ReadMode -> withro (\h -> vOpen h fp mode) fh- _ -> roerror fh+ _ -> roerror fh ---------------------------------------------------------------------- -- Restricting to a subdirectory
src/System/IO/HVFS/InstanceHelpers.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Safe #-} {- arch-tag: HVFS instance helpers Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +10,8 @@ {- | Module : System.IO.HVFS.InstanceHelpers Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -33,21 +33,23 @@ getFullSlice) where -import Data.IORef (newIORef, readIORef, writeIORef, IORef())-import Data.List (genericLength)-import System.IO -- (ReadMode)-import System.IO.Error (doesNotExistErrorType, illegalOperationErrorType, permissionErrorType)-import System.IO.HVFS-import System.IO.HVIO (newStreamReader)-import System.Path (absNormPath)-import System.Path.NameManip (slice_path)-import System.FilePath ((</>), pathSeparator, isPathSeparator)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.List (genericLength)+import System.FilePath (isPathSeparator, pathSeparator, (</>))+import System.IO+import System.IO.Error (doesNotExistErrorType,+ illegalOperationErrorType,+ permissionErrorType)+import System.IO.HVFS+import System.IO.HVIO (newStreamReader)+import System.Path (absNormPath)+import System.Path.NameManip (slice_path) {- | A simple "System.IO.HVFS.HVFSStat" class that assumes that everything is either a file or a directory. -} data SimpleStat = SimpleStat {- isFile :: Bool, -- ^ True if file, False if directory+ isFile :: Bool, -- ^ True if file, False if directory fileSize :: FileOffset -- ^ Set to 0 if unknown or a directory } deriving (Show, Eq) instance HVFSStat SimpleStat where@@ -71,7 +73,7 @@ resizable ramdisk written in Haskell. -} data MemoryVFS = MemoryVFS { content :: IORef [MemoryNode],- cwd :: IORef FilePath+ cwd :: IORef FilePath } instance Show MemoryVFS where@@ -99,7 +101,7 @@ nice_slice :: String -> [String] nice_slice path | path == [pathSeparator] = []- | otherwise = + | otherwise = let sliced1 = slice_path path h = head sliced1 t = tail sliced1@@ -152,7 +154,7 @@ in do c <- readIORef $ content x case walk (MemoryDirectory c) (sliced2) of- Left err -> vRaiseError x doesNotExistErrorType err Nothing+ Left err -> vRaiseError x doesNotExistErrorType err Nothing Right result -> return result -- | Find an element on the tree, normalizing the path first
src/System/IO/HVFS/Utils.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}+ {- arch-tag: HVFS utilities main file Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -10,13 +11,12 @@ {- | Module : System.IO.HVFS.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable -This module provides various helpful utilities for dealing +This module provides various helpful utilities for dealing filesystems. Written by John Goerzen, jgoerzen\@complete.org@@ -33,16 +33,16 @@ ) where -import System.IO.HVFS-import System.Time.Utils-import System.IO.PlafCompat-import Text.Printf-import System.Time-import System.Locale-import System.IO.Unsafe-import System.FilePath ((</>), pathSeparator)+import System.FilePath (pathSeparator, (</>))+import System.IO.HVFS+import System.IO.PlafCompat+import System.IO.Unsafe (unsafeInterleaveIO)+import System.Locale+import System.Time+import System.Time.Utils+import Text.Printf -{- | Obtain a recursive listing of all files\/directories beneath +{- | Obtain a recursive listing of all files\/directories beneath the specified directory. The traversal is depth-first and the original item is always present in the returned list.@@ -68,12 +68,12 @@ -} recurseDirStat :: HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]-recurseDirStat h fn = +recurseDirStat h fn = do fs <- vGetSymbolicLinkStatus h fn- if withStat fs vIsDirectory + if withStat fs vIsDirectory then do dirc <- vGetDirectoryContents h fn- let contents = map ((++) (fn ++ [pathSeparator])) $ + let contents = map ((++) (fn ++ [pathSeparator])) $ filter (\x -> x /= "." && x /= "..") dirc subdirs <- unsafeInterleaveIO $ mapM (recurseDirStat h) contents return $ (concat subdirs) ++ [(fn, fs)]@@ -85,7 +85,7 @@ recursiveRemove :: HVFS a => a -> FilePath -> IO () recursiveRemove h fn = recurseDirStat h fn >>= (mapM_ $- \(fn, fs) -> if withStat fs vIsDirectory + \(fn, fs) -> if withStat fs vIsDirectory then vRemoveDirectory h fn else vRemoveFile h fn )@@ -96,7 +96,7 @@ -} lsl :: HVFS a => a -> FilePath -> IO String lsl fs fp =- let showmodes mode = + let showmodes mode = let i m = (intersectFileModes mode m /= 0) in (if i ownerReadMode then 'r' else '-') :@@ -110,10 +110,10 @@ (if i otherReadMode then 'r' else '-') : (if i otherWriteMode then 'w' else '-') : (if i otherExecuteMode then 'x' else '-') : []- showentry origdir fh (state, fp) = + showentry origdir fh (state, fp) = case state of- HVFSStatEncap se -> - let typechar = + HVFSStatEncap se ->+ let typechar = if vIsDirectory se then 'd' else if vIsSymbolicLink se then 'l' else if vIsBlockDevice se then 'b'@@ -122,15 +122,15 @@ else if vIsNamedPipe se then 's' else '-' clocktime = epochToClockTime (vModificationTime se)- datestr c= formatCalendarTime defaultTimeLocale "%b %e %Y" + datestr c= formatCalendarTime defaultTimeLocale "%b %e %Y" c in do c <- toCalendarTime clocktime linkstr <- case vIsSymbolicLink se of False -> return ""- True -> do sl <- vReadSymbolicLink fh + True -> do sl <- vReadSymbolicLink fh (origdir </> fp) return $ " -> " ++ sl- return $ printf "%c%s 1 %-8d %-8d %-9d %s %s%s" + return $ printf "%c%s 1 %-8d %-8d %-9d %s %s%s" typechar (showmodes (vFileMode se)) (toInteger $ vFileOwner se)@@ -141,9 +141,9 @@ linkstr in do c <- vGetDirectoryContents fs fp pairs <- mapM (\x -> do ss <- vGetSymbolicLinkStatus fs (fp </> x)- return (ss, x) + return (ss, x) ) c linedata <- mapM (showentry fp fs) pairs return $ unlines $ ["total 1"] ++ linedata- - ++
src/System/IO/HVIO.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-}+ {- arch-tag: HVIO main file Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -10,9 +11,8 @@ {- | Module : System.IO.HVIO Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -120,14 +120,14 @@ ) where -import System.IO-import System.IO.Error-import qualified Control.Exception (catch, IOException)-import Control.Concurrent.MVar-import Data.IORef-import Foreign.Ptr-import Foreign.C-import Foreign.Storable+import Control.Concurrent.MVar+import qualified Control.Exception (IOException, catch)+import Data.IORef+import Foreign.C+import Foreign.Ptr+import Foreign.Storable+import System.IO+import System.IO.Error {- | This is the generic I\/O support class. All objects that are to be used in the HVIO system must provide an instance of 'HVIO'.@@ -286,7 +286,7 @@ let func = do c <- vGetChar h case c of '\n' -> return accum- x -> accum `seq` loop (accum ++ [x])+ x -> accum `seq` loop (accum ++ [x]) handler e = if isEOFError e then return accum else ioError e in Control.Exception.catch func handler@@ -294,7 +294,7 @@ do firstchar <- vGetChar h case firstchar of '\n' -> return []- x -> loop [x]+ x -> loop [x] vGetContents h = let loop =@@ -357,9 +357,7 @@ instance HVIO Handle where vClose = hClose vIsEOF = hIsEOF-#ifdef __GLASGOW_HASKELL__ vShow = hShow-#endif vMkIOError h et desc mfp = mkIOError et desc (Just h) mfp vGetChar = hGetChar@@ -434,7 +432,7 @@ d <- vioc_get (srv h) return $ case d of [] -> True- _ -> False+ _ -> False vIsOpen = vioc_isopen . srv vGetChar h = do vTestEOF h c <- vioc_get (srv h)@@ -542,7 +540,7 @@ let newpos = case seekmode of AbsoluteSeek -> seekpos RelativeSeek -> pos + seekpos- SeekFromEnd -> (length buf) + seekpos+ SeekFromEnd -> (length buf) + seekpos let buf2 = buf ++ if newpos > (length buf) then replicate (newpos - (length buf)) '\0' else []
src/System/IO/PlafCompat.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {- Platform Compatibility Layer Copyright (c) 2005-2011 John Goerzen <jgoerzen@complete.org>@@ -11,9 +11,8 @@ {- | Module : System.IO.PlafCompat Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -35,11 +34,11 @@ module System.Posix.Types) where -import System.Posix.Types+import System.Posix.Types #if (defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))-import System.IO.WindowsCompat+import System.IO.WindowsCompat #else-import System.Posix.Files+import System.Posix.Files #endif {- | The name of the null device. NUL: on Windows, \/dev\/null everywhere else.
src/System/IO/StatCompat.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {- Copyright (c) 2005-2011 John Goerzen <jgoerzen@complete.org>@@ -11,9 +11,8 @@ {- | Module : System.IO.StatCompat Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -24,12 +23,12 @@ module System.IO.StatCompat where-import System.Posix.Types-import System.Posix.Consts+import System.Posix.Consts+import System.Posix.Types #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))-import System.Posix.Files(intersectFileModes)+import System.Posix.Files (intersectFileModes) #endif-import Data.Bits ((.&.))+import Data.Bits ((.&.)) #if (defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) type LinkCount = Int@@ -38,15 +37,15 @@ #endif data FileStatusCompat =- FileStatusCompat {deviceID :: DeviceID,- fileID :: FileID,- fileMode :: FileMode,- linkCount :: LinkCount,- fileOwner :: UserID,- fileGroup :: GroupID,- specialDeviceID :: DeviceID,- fileSize :: FileOffset,- accessTime :: EpochTime,+ FileStatusCompat {deviceID :: DeviceID,+ fileID :: FileID,+ fileMode :: FileMode,+ linkCount :: LinkCount,+ fileOwner :: UserID,+ fileGroup :: GroupID,+ specialDeviceID :: DeviceID,+ fileSize :: FileOffset,+ accessTime :: EpochTime, modificationTime :: EpochTime, statusChangeTime :: EpochTime }
src/System/IO/Utils.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Trustworthy #-}+ {- Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : System.IO.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable -}@@ -34,10 +35,10 @@ optimizeForBatch, optimizeForInteraction ) where -import System.IO.Unsafe (unsafeInterleaveIO)-import System.IO-import Data.List (genericLength)-import System.IO.HVIO+import Data.List (genericLength)+import System.IO+import System.IO.HVIO+import System.IO.Unsafe (unsafeInterleaveIO) {- | Given a list of strings, output a line containing each item, adding newlines as appropriate. The list is not expected to have newlines already.
src/System/IO/WindowsCompat.hs view
@@ -11,9 +11,8 @@ {- | Module : System.IO.WindowsCompat Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable
src/System/Path.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Safe #-} {- arch-tag: Path utilities main file Copyright (C) 2004-2011 John Goerzen <jgoerzen@complete.org> @@ -10,9 +11,8 @@ {- | Module : System.Path Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -31,21 +31,21 @@ mktmpdir, brackettmpdir, brackettmpdirCWD ) where-import Data.List-import Data.List.Utils+import Data.List+import Data.List.Utils #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))-import System.Posix.Files-import System.Posix.Directory (createDirectory)-import System.Posix.Temp-import System.Directory hiding (createDirectory)+import System.Directory hiding (createDirectory)+import System.Posix.Directory (createDirectory)+import System.Posix.Files+import System.Posix.Temp #else-import System.Directory+import System.Directory #endif-import System.FilePath ((</>), pathSeparator, isPathSeparator)-import Control.Exception-import System.IO-import System.Path.NameManip-import System.IO.HVFS.Utils+import Control.Exception+import System.FilePath (isPathSeparator, pathSeparator, (</>))+import System.IO+import System.IO.HVFS.Utils+import System.Path.NameManip {- | Splits a pathname into a tuple representing the root of the name and the extension. The extension is considered to be all characters from the last@@ -79,7 +79,7 @@ let abs = absolute_path_by base thepath in case guess_dotdot (normalise_path abs) of Just "." -> Just [pathSeparator]- x -> x+ x -> x {- | Like absNormPath, but returns Nothing if the generated result is not the passed base path or a subdirectory thereof. -}@@ -111,16 +111,12 @@ createDirectory dirname 0o700 return dirname #else-#ifdef __GLASGOW_HASKELL__ mktmpdir x = do (fp, h) <- openTempFile "" x hClose h removeFile fp createDirectory fp return fp-#else-mktmpdir _ = fail "mktmpdir not supported on Windows unless you have GHC"-#endif #endif {- | Creates a temporary directory for your use via 'mktmpdir',
src/System/Path/Glob.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Safe #-}+ {- Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : System.Path.Glob Copyright : Copyright (C) 2006-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -24,12 +25,13 @@ module System.Path.Glob (glob, vGlob) where-import Data.List.Utils (hasAny)-import System.IO.HVFS-import System.FilePath (splitFileName, (</>), pathSeparator, isPathSeparator)-import Control.Exception (tryJust)-import System.Path.WildMatch (wildCheckCase)-import Data.List (isSuffixOf)+import Control.Exception (tryJust)+import Data.List (isSuffixOf)+import Data.List.Utils (hasAny)+import System.FilePath (isPathSeparator, pathSeparator,+ splitFileName, (</>))+import System.IO.HVFS+import System.Path.WildMatch (wildCheckCase) hasWild :: String -> Bool hasWild = hasAny "*?["
src/System/Path/NameManip.hs view
@@ -2,9 +2,8 @@ {- | Module : System.Path.NameManip Copyright : Copyright (C) 2004 Volker Wysk- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -15,9 +14,9 @@ module System.Path.NameManip where -import Data.List (intercalate, unfoldr)-import System.Directory (getCurrentDirectory)-import System.FilePath ((</>), pathSeparator, isPathSeparator)+import Data.List (intercalate, unfoldr)+import System.Directory (getCurrentDirectory)+import System.FilePath (isPathSeparator, pathSeparator, (</>)) {- | Split a path in components. Repeated \"@\/@\" characters don\'t lead to empty components. \"@.@\" path components are removed. If the path is absolute, the first component@@ -42,7 +41,7 @@ slice_path "" = [] slice_path (c:cs) = if isPathSeparator c then case slice_path' cs of- [] -> [[c]]+ [] -> [[c]] (p:ps) -> (c:p):ps else slice_path' (c:cs) where
src/System/Path/WildMatch.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Trustworthy #-}+ {- Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org> @@ -9,9 +11,8 @@ {- | Module : System.Path.WildMatch Copyright : Copyright (C) 2006-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -55,8 +56,8 @@ wildToRegex) where -import Text.Regex-import Data.String.Utils+import Data.String.Utils+import Text.Regex {- | Convert a wildcard to an (uncompiled) regular expression. @@ -74,20 +75,20 @@ wildCheckCase patt name = case matchRegex (mkRegex $ "^" ++ wildToRegex patt) name of Nothing -> False- Just _ -> True+ Just _ -> True -- This is SO MUCH CLEANER than the python implementation! convwild :: String -> String-convwild [] = []-convwild ('*':xs) = ".*" ++ convwild xs-convwild ('?':xs) = "." ++ convwild xs+convwild [] = []+convwild ('*':xs) = ".*" ++ convwild xs+convwild ('?':xs) = "." ++ convwild xs convwild ('[':'!':xs) = "[^" ++ convpat xs-convwild ('[':xs) = '[' : convpat xs-convwild ('.':xs) = "\\." ++ convwild xs-convwild (x:xs) = escapeRe [x] ++ convwild xs+convwild ('[':xs) = '[' : convpat xs+convwild ('.':xs) = "\\." ++ convwild xs+convwild (x:xs) = escapeRe [x] ++ convwild xs convpat :: String -> String convpat ('\\':xs) = "\\\\" ++ convpat xs-convpat (']':xs) = ']' : convwild xs-convpat (x:xs) = x : convpat xs-convpat [] = []+convpat (']':xs) = ']' : convwild xs+convpat (x:xs) = x : convpat xs+convpat [] = []
src/System/Posix/Consts.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {- Posix consts not included with Haskell Copyright (c) 2005-2011 John Goerzen <jgoerzen@complete.org>@@ -11,9 +10,8 @@ {- | Module : System.Posix.Consts Copyright : Copyright (C) 2005-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -23,7 +21,7 @@ -} module System.Posix.Consts where-import System.Posix.Types+import System.Posix.Types blockSpecialMode :: FileMode blockSpecialMode = 0o0060000
src/System/Time/Utils.hs view
@@ -10,9 +10,8 @@ {- | Module : System.Time.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -32,8 +31,8 @@ renderSecs, renderTD ) where-import System.Time-import Data.Ratio+import Data.Ratio+import System.Time {- | January 1, 1970, midnight, UTC, represented as a CalendarTime. -} epoch :: CalendarTime@@ -57,7 +56,7 @@ timegm ct = timeDiffToSecs (diffClockTimes (toClockTime ct) (toClockTime epoch)) -{- | Converts the specified CalendarTime (see System.Time) to +{- | Converts the specified CalendarTime (see System.Time) to seconds-since-epoch format. The input CalendarTime is assumed to be the time as given in your local@@ -77,12 +76,12 @@ let newct = ct {ctTZ = ctTZ guessct} return $ timegm newct where guesscl = toClockTime ct- -{- | Converts the given timeDiff to the number of seconds it represents. +{- | Converts the given timeDiff to the number of seconds it represents.+ Uses the same algorithm as normalizeTimeDiff in GHC. -} timeDiffToSecs :: TimeDiff -> Integer-timeDiffToSecs td = +timeDiffToSecs td = (fromIntegral $ tdSec td) + 60 * ((fromIntegral $ tdMin td) + 60 * ((fromIntegral $ tdHour td) +@@ -100,7 +99,7 @@ seconds = floor ratval secfrac = floor $ (ratval - (seconds % 1) ) * picosecondfactor picosecondfactor = 10 ^ 12- + {- | Converts a ClockTime to something represented with an arbitrary Real. The result could be treated as a CTime from Foreign.C.Types or EpochTime from System.Posix.Types. The inverse of 'epochToClockTime'.@@ -125,7 +124,7 @@ renderTD itd = case workinglist of [] -> "0s"- _ -> concat . map (\(q, s) -> show q ++ [s]) $ workinglist+ _ -> concat . map (\(q, s) -> show q ++ [s]) $ workinglist where td = normalizeTimeDiff itd suffixlist = "yMdhms" quantlist = (\(TimeDiff y mo d h m s _) -> [y, mo, d, h, m, s]) td
src/Text/ParserCombinators/Parsec/Utils.hs view
@@ -10,9 +10,8 @@ {- | Module : Text.ParserCombinators.Parsec.Utils Copyright : Copyright (C) 2004-2011 John Goerzen- License : BSD3+ SPDX-License-Identifier: BSD-3-Clause - Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -30,7 +29,7 @@ notMatching ) where -import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec type GeneralizedToken a = (SourcePos, a) type GeneralizedTokenParser a st b = GenParser (GeneralizedToken a) st b@@ -86,8 +85,8 @@ If it fails, returns (). If it succeds, cause a failure and raise the given error message. It will not consume input in either case. -} notMatching :: GenParser a b c -> String -> GenParser a b ()-notMatching p errormsg = - let maybeRead = try (do +notMatching p errormsg =+ let maybeRead = try (do x <- p return (Just x) )@@ -96,7 +95,7 @@ x <- maybeRead case x of Nothing -> return ()- Just _ -> unexpected errormsg+ Just _ -> unexpected errormsg in try workerFunc
testsrc/Eithertest.hs view
@@ -8,11 +8,11 @@ -} module Eithertest(tests) where-import Test.HUnit-import Data.Either.Utils-import Test.HUnit.Tools-import Control.Exception-import Control.Exception.ErrorCall.EqInstance+import Control.Exception+import Control.Exception.ErrorCall.EqInstance+import Data.Either.Utils+import Test.HUnit+import TestUtils test_maybeToEither = let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" exp inp in@@ -22,7 +22,7 @@ f "Nothing diff types" (maybeToEither "error" (Nothing::Maybe Int)) (Left "error"), f "Just" (maybeToEither "error" (Just "good")) (Right "good"),- f "Diff types" (maybeToEither "error" (Just (5::Int))) + f "Diff types" (maybeToEither "error" (Just (5::Int))) (Right (5::Int)) ] @@ -30,9 +30,8 @@ let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" exp inp in [ f "Right" (forceEither ((Right "foo")::Either Int String)) "foo",- TestLabel "Left" $ TestCase $ assertRaises ""- (ErrorCallWithLocation "\"wrong\"" "CallStack (from HasCallStack):\n error, called at src/Data/Either/Utils.hs:51:24 in main:Data.Either.Utils")- ("" @=? forceEither (Left "wrong"))++ TestLabel "Left" $ TestCase $ assertRaises ((== "\"wrong\"") . errorCallMsg) ("" @=? forceEither (Left "wrong")) ] tests = TestList [TestLabel "test_maybeToEither" (TestList test_maybeToEither),
testsrc/Globtest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {- Copyright (C) 2006-2011 John Goerzen <jgoerzen@complete.org> @@ -12,7 +14,7 @@ import Test.HUnit import System.Path.Glob import System.Path-import Test.HUnit.Tools+import TestUtils import System.IO.HVFS import System.Directory(createDirectory) #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
testsrc/HVFStest.hs view
@@ -12,7 +12,7 @@ import System.IO.HVFS import System.IO.HVFS.InstanceHelpers import System.IO.HVFS.Combinators-import Test.HUnit.Tools+import TestUtils import System.IO import System.IO.Error import Control.Exception
testsrc/HVIOtest.hs view
@@ -7,12 +7,12 @@ -} module HVIOtest(tests) where-import Test.HUnit-import System.IO.HVIO-import Test.HUnit.Tools+import Control.Exception import System.IO import System.IO.Error-import Control.Exception+import System.IO.HVIO+import Test.HUnit+import TestUtils ioeq :: (Show a, Eq a) => a -> IO a -> Assertion ioeq exp inp = do x <- inp@@ -24,7 +24,7 @@ in [ f "" (\x -> do True `ioeq` vIsOpen x- assertRaises "eof error" (mkIOError eofErrorType "" Nothing Nothing) (vGetChar x)+ assertRaises (== mkIOError eofErrorType "" Nothing Nothing) (vGetChar x) vPutStrLn x "Line1" vPutStrLn x "Line2" vRewind x@@ -41,10 +41,10 @@ vPutStr x "IN" vRewind x "LINe1" `ioeq` vGetLine x- "Line2" `ioeq` vGetLine x + "Line2" `ioeq` vGetLine x vSeek x SeekFromEnd 0 vPutChar x 'c'- assertRaises "eof error" (mkIOError eofErrorType "" Nothing Nothing) (vGetLine x)+ assertRaises (== mkIOError eofErrorType "" Nothing Nothing) (vGetLine x) vRewind x "LINe1\nLine2\nc" `ioeq` vGetContents x )@@ -53,14 +53,14 @@ test_StreamReader = let f inp testfunc = TestLabel inp $ TestCase $ do x <- newStreamReader inp testfunc x- in + in [ f "" (\x -> do True `ioeq` vIsEOF x True `ioeq` vIsOpen x- assertRaises "eof error" (mkIOError eofErrorType "" Nothing Nothing) (vGetChar x)+ assertRaises (== mkIOError eofErrorType "" Nothing Nothing) (vGetChar x) vClose x False `ioeq` vIsOpen x- + ) ,f "abcd" (\x -> do False `ioeq` vIsEOF x True `ioeq` vIsOpen x@@ -76,7 +76,7 @@ "" `ioeq` vGetLine x "line5" `ioeq` vGetLine x "lastline" `ioeq` vGetLine x- assertRaises "eof error" (mkIOError eofErrorType "" Nothing Nothing) (vGetLine x)+ assertRaises (== mkIOError eofErrorType "" Nothing Nothing) (vGetLine x) ) ]
testsrc/IOtest.hs view
@@ -10,7 +10,7 @@ module IOtest() where import Test.HUnit import System.IO-import Test.HUnit.Tools+import TestUtils
testsrc/Listtest.hs view
@@ -7,14 +7,13 @@ -} module Listtest(tests) where-import Test.HUnit-import Data.List.Utils-import Data.List-import Test.HUnit-import Test.QuickCheck as QC-import Test.HUnit.Tools+import Data.List+import Data.List.Utils+import Test.HUnit+import Test.HUnit+-- import Test.QuickCheck as QC -test_delFromAL = +test_delFromAL = let f :: [(String, Int)] -> [(String, Int)] -> Test f inp exp = TestCase $ exp @=? (delFromAL inp "testkey") in [@@ -115,7 +114,7 @@ ,f 2 [1, 2, 3, 4, 5] [1, 2] ,f 10 "Hello" "Hello" ,f 0 "" ""- ] + ] test_contains = let f msg sub testlist exp = TestCase $ assertEqual msg exp (contains sub testlist) in@@ -154,8 +153,8 @@ ,f 'f' ['f', 'b', 'f', 'f', 'b'] 3 ] -test_subIndex = - let f item inp exp = TestCase $ exp @=? subIndex item inp in +test_subIndex =+ let f item inp exp = TestCase $ exp @=? subIndex item inp in [f "foo" "asdfoobar" (Just 3) ,f "foo" [] (Nothing) ,f "" [] (Just 0)@@ -179,7 +178,7 @@ ,f [1, 2, 3] "1234567890" ["1","23","456","7890"] ,f (repeat 2) "123456789" ["12","34","56","78","9"] ,f [] "123456789" ["123456789"]- ,f [5, 3, 6, 1] "Hello, This is a test." + ,f [5, 3, 6, 1] "Hello, This is a test." ["Hello",", T","his is"," ","a test."] ] @@ -208,23 +207,23 @@ f (contains "foo") "foo" ("f", "oo")] -test_merge =- qctest "prop_merge" prop_merge+-- test_merge =+-- qctest "prop_merge" prop_merge prop_merge xs ys = merge (sort xs) (sort ys) == sort (xs ++ ys) where types = xs :: [Int] -test_mergeBy =- qctest "test_mergeBy" prop_mergeBy+-- test_mergeBy =+-- qctest "test_mergeBy" prop_mergeBy prop_mergeBy xs ys = mergeBy cmp (sortBy cmp xs) (sortBy cmp ys) == sortBy cmp (xs ++ ys) where types = xs :: [Int] cmp = compare -tests = TestList [test_merge,- test_mergeBy,+tests = TestList [-- test_merge,+ -- test_mergeBy, TestLabel "delFromAL" (TestList test_delFromAL), TestLabel "uniq" (TestList test_uniq), TestLabel "addToAL" (TestList test_addToAL),
testsrc/Strtest.hs view
@@ -9,7 +9,7 @@ module Strtest(tests) where import Test.HUnit import Data.String.Utils-import Test.HUnit.Tools+import TestUtils import Text.Regex import Data.Char
+ testsrc/TestUtils.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE CPP #-}++module TestUtils (mapassertEqual, assertRaises, errorCallMsg) where++import Control.Exception (ErrorCall (..), Exception,+ Handler (Handler), SomeException, catches)+import Test.HUnit (Assertion, Test (TestCase), assertEqual,+ assertFailure)++mapassertEqual :: (Show b, Eq b) => String -> (a -> b) -> [(a, b)] -> [Test]+mapassertEqual label f xs+ = [ TestCase $ assertEqual label result (f inp) | (inp,result) <- xs ]+++assertRaises :: (Exception e, Show e) => (e -> Bool) -> IO a -> Assertion+assertRaises check act = do+ res <- go `catches` [ Handler check', Handler anyEx ]+ res+ where+ go = act >> return (assertFailure "action completed without exception")++ check' ex+ | check ex = return (return ())+ | otherwise = return (assertFailure ("got exception of expected type *but* wrong value: " ++ show ex))++ anyEx :: SomeException -> IO (Assertion)+ anyEx ex = return (assertFailure ("got unexpected exception type: " ++ show ex))+++errorCallMsg :: ErrorCall -> String+errorCallMsg (ErrorCall msg) = msg+#if MIN_VERSION_base(4,9,0)+errorCallMsg (ErrorCallWithLocation msg _) = msg+#endif
testsrc/Tests.hs view
@@ -16,7 +16,6 @@ import qualified IOtest import qualified Bitstest import qualified Eithertest-import qualified CRC32POSIXtest import qualified CRC32GZIPtest import qualified GZiptest import qualified HVIOtest@@ -44,7 +43,6 @@ TestLabel "MIMETypes" MIMETypestest.tests, TestLabel "Bitstest" Bitstest.tests, TestLabel "Eithertest" Eithertest.tests,- TestLabel "CRC32POSIXtest" CRC32POSIXtest.tests, TestLabel "CRC32GZIPtest" CRC32GZIPtest.tests, TestLabel "GZiptest" GZiptest.tests]
testsrc/WildMatchtest.hs view
@@ -11,7 +11,7 @@ module WildMatchtest(tests) where import Test.HUnit import System.Path.WildMatch-import Test.HUnit.Tools+import TestUtils test_wildCheckCase = let f patt name = TestCase $ assertBool (patt ++ "," ++ name ++ " was false")
− tolgpl
@@ -1,7 +0,0 @@-#!/bin/bash-ssed -i -e 's/GNU General/GNU Lesser General/g' \- -e 's/ GPL/ LGPL/g' \- -e 's/version 2 /version 2.1 /g' \- -e 's/59 Temple Place, Suite 330, Boston, MA 02111-1307/51 Franklin St, Fifth Floor, Boston, MA 02110-1301/g' \- $1-
− winbuild.bat
@@ -1,4 +0,0 @@-ghc -package Cabal Setup.hs -o setup.exe -setup configure -setup build -
− wintest.bat
@@ -1,5 +0,0 @@-cd testsrc -ghc --make -package hslogger -package FilePath -package mtl -package HUnit -fallow-overlapping-instances -fallow-undecidable-instances -fglasgow-exts -cpp -o runtests.exe -i..\dist\build:..\src runtests.hs -cd .. -testsrc\runtests -