07cfb8f...master · typeable/uuid

.github/workflows/haskell-ci-bench.yml+11−6

@@ -8,9 +8,9 @@

88#

99# For more information, see https://github.com/haskell-CI/haskell-ci

1010#

11−# version: 0.19.20240514

11+# version: 0.19.20240702

1212#

13−# REGENDATA ("0.19.20240514",["github","--project","cabal.bench.project","-o",".github/workflows/haskell-ci-bench.yml","--github-action-name","Benchmarks"])

13+# REGENDATA ("0.19.20240702",["github","--project","cabal.bench.project","-o",".github/workflows/haskell-ci-bench.yml","--github-action-name","Benchmarks"])

1414#

1515name: Benchmarks

1616on:

@@ -32,14 +32,19 @@ jobs:

3232 strategy:

3333 matrix:

3434 include:

35+ - compiler: ghc-9.10.1

36+ compilerKind: ghc

37+ compilerVersion: 9.10.1

38+ setup-method: ghcup

39+ allow-failure: false

3540 - compiler: ghc-9.8.2

3641 compilerKind: ghc

3742 compilerVersion: 9.8.2

3843 setup-method: ghcup

3944 allow-failure: false

40− - compiler: ghc-9.6.4

45+ - compiler: ghc-9.6.6

4146 compilerKind: ghc

42− compilerVersion: 9.6.4

47+ compilerVersion: 9.6.6

4348 setup-method: ghcup

4449 allow-failure: false

4550 - compiler: ghc-9.4.8

@@ -82,7 +87,7 @@ jobs:

8287 curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

8388 chmod a+x "$HOME/.ghcup/bin/ghcup"

8489 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

85− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

90+ "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

8691 env:

8792 HCKIND: ${{ matrix.compilerKind }}

8893 HCNAME: ${{ matrix.compiler }}

@@ -100,7 +105,7 @@ jobs:

100105 echo "HC=$HC" >> "$GITHUB_ENV"

101106 echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"

102107 echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"

103− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

108+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"

104109 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

105110 echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

106111 echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

.github/workflows/haskell-ci.yml+35−25

@@ -8,9 +8,9 @@

88#

99# For more information, see https://github.com/haskell-CI/haskell-ci

1010#

11−# version: 0.19.20240514

11+# version: 0.19.20241223

1212#

13−# REGENDATA ("0.19.20240514",["github","cabal.project"])

13+# REGENDATA ("0.19.20241223",["github","cabal.project"])

1414#

1515name: Haskell-CI

1616on:

@@ -32,19 +32,24 @@ jobs:

3232 strategy:

3333 matrix:

3434 include:

35+ - compiler: ghc-9.12.1

36+ compilerKind: ghc

37+ compilerVersion: 9.12.1

38+ setup-method: ghcup

39+ allow-failure: false

3540 - compiler: ghc-9.10.1

3641 compilerKind: ghc

3742 compilerVersion: 9.10.1

3843 setup-method: ghcup

3944 allow-failure: false

40− - compiler: ghc-9.8.2

45+ - compiler: ghc-9.8.4

4146 compilerKind: ghc

42− compilerVersion: 9.8.2

47+ compilerVersion: 9.8.4

4348 setup-method: ghcup

4449 allow-failure: false

45− - compiler: ghc-9.6.5

50+ - compiler: ghc-9.6.6

4651 compilerKind: ghc

47− compilerVersion: 9.6.5

52+ compilerVersion: 9.6.6

4853 setup-method: ghcup

4954 allow-failure: false

5055 - compiler: ghc-9.4.8

@@ -79,15 +84,29 @@ jobs:

7984 allow-failure: false

8085 fail-fast: false

8186 steps:

82− - name: apt

87+ - name: apt-get install

8388 run: |

8489 apt-get update

8590 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

91+ - name: Install GHCup

92+ run: |

8693 mkdir -p "$HOME/.ghcup/bin"

87− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

94+ curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"

8895 chmod a+x "$HOME/.ghcup/bin/ghcup"

96+ - name: Install cabal-install

97+ run: |

98+ "$HOME/.ghcup/bin/ghcup" install cabal 3.14.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

99+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"

100+ - name: Install GHC (GHCup)

101+ if: matrix.setup-method == 'ghcup'

102+ run: |

89103 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

90− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

104+ HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")

105+ HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')

106+ HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')

107+ echo "HC=$HC" >> "$GITHUB_ENV"

108+ echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"

109+ echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"

91110 env:

92111 HCKIND: ${{ matrix.compilerKind }}

93112 HCNAME: ${{ matrix.compiler }}

@@ -98,21 +117,12 @@ jobs:

98117 echo "LANG=C.UTF-8" >> "$GITHUB_ENV"

99118 echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"

100119 echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

101− HCDIR=/opt/$HCKIND/$HCVER

102− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")

103− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')

104− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')

105− echo "HC=$HC" >> "$GITHUB_ENV"

106− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"

107− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"

108− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

109120 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

110121 echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

111122 echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

112123 echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

113124 echo "HEADHACKAGE=false" >> "$GITHUB_ENV"

114125 echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"

115− echo "GHCJSARITH=0" >> "$GITHUB_ENV"

116126 env:

117127 HCKIND: ${{ matrix.compilerKind }}

118128 HCNAME: ${{ matrix.compiler }}

@@ -169,7 +179,7 @@ jobs:

169179 run: |

170180 touch cabal.project

171181 echo "packages: $GITHUB_WORKSPACE/source/uuid-types" >> cabal.project

172− if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/uuid" >> cabal.project ; fi

182+ echo "packages: $GITHUB_WORKSPACE/source/uuid" >> cabal.project

173183 cat cabal.project

174184 - name: sdist

175185 run: |

@@ -189,11 +199,11 @@ jobs:

189199 touch cabal.project

190200 touch cabal.project.local

191201 echo "packages: ${PKGDIR_uuid_types}" >> cabal.project

192− if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "packages: ${PKGDIR_uuid}" >> cabal.project ; fi

202+ echo "packages: ${PKGDIR_uuid}" >> cabal.project

193203 echo "package uuid-types" >> cabal.project

194204 echo " ghc-options: -Werror=missing-methods" >> cabal.project

195− if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo "package uuid" >> cabal.project ; fi

196− if [ $((HCNUMVER < 91000)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi

205+ echo "package uuid" >> cabal.project

206+ echo " ghc-options: -Werror=missing-methods" >> cabal.project

197207 cat >> cabal.project <<EOF

198208 EOF

199209 $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(uuid|uuid-types)$/; }' >> cabal.project.local

@@ -226,8 +236,8 @@ jobs:

226236 run: |

227237 cd ${PKGDIR_uuid_types} || false

228238 ${CABAL} -vnormal check

229− if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cd ${PKGDIR_uuid} || false ; fi

230− if [ $((HCNUMVER < 91000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi

239+ cd ${PKGDIR_uuid} || false

240+ ${CABAL} -vnormal check

231241 - name: haddock

232242 run: |

233243 $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

@@ -245,8 +255,8 @@ jobs:

245255 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' --dependencies-only -j2 all

246256 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all

247257 - name: save cache

248− uses: actions/cache/save@v4

249258 if: always()

259+ uses: actions/cache/save@v4

250260 with:

251261 key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

252262 path: ~/.cabal/store

cabal.haskell-ci+1−1

@@ -1,5 +1,5 @@

11branches: master

2−jobs-selection: any

2+-- jobs-selection: any

33head-hackage: False

44

55constraint-set random-1.2

uuid-bench/bench/uuid-benchmark.hs−1

@@ -3,7 +3,6 @@ import Data.Char (ord)

33import Data.IORef

44import Data.Word

55import qualified Data.UUID as U

6−import qualified Data.UUID.V1 as U

76import qualified Data.UUID.V4 as U

87import qualified Data.UUID.V3 as U3

98import qualified Data.UUID.V5 as U5

uuid-bench/uuid-bench.cabal+7−7

@@ -20,8 +20,9 @@ tested-with:

2020 || ==9.0.2

2121 || ==9.2.8

2222 || ==9.4.8

23− || ==9.6.4

23+ || ==9.6.6

2424 || ==9.8.2

25+ || ==9.10.1

2526

2627synopsis: UUID benchmarks

2728description:

@@ -46,10 +47,10 @@ library

4647 , cryptohash-sha1 >=0.11.100 && <0.12

4748 , deepseq >=1.4.4.0 && <1.6

4849 , entropy >=0.3.7 && <0.5

49− , hashable >=1.4.4.0 && <1.5

50+ , hashable >=1.4.4.0 && <1.6

5051 , network-info >=0.2 && <0.3

5152 , random >=1.2.1.2 && <1.3

52− , template-haskell >=2.14.0.0 && <2.22

53+ , template-haskell >=2.14.0.0 && <2.23

5354 , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2

5455 , time >=1.4 && <1.13

5556

@@ -57,7 +58,6 @@ library

5758 exposed-modules:

5859 Data.UUID

5960 Data.UUID.Util

60− Data.UUID.V1

6161 Data.UUID.V3

6262 Data.UUID.V4

6363 Data.UUID.V5

@@ -99,13 +99,13 @@ benchmark uuid-types-benchmark

9999

100100 -- deps w/o inherited constraints

101101 build-depends:

102− containers >=0.5 && <0.7

102+ containers >=0.5 && <0.8

103103 , criterion >=1.5 && <1.7

104104 , unordered-containers >=0.2.7 && <0.3

105105

106106benchmark uuid-benchmark

107107 type: exitcode-stdio-1.0

108− main-is: uuid-benchmark.hs

108+ main-is: uuid-benchmark.hs

109109 hs-source-dirs: bench

110110 default-language: Haskell2010

111111 default-extensions:

@@ -118,7 +118,7 @@ benchmark uuid-benchmark

118118 build-depends:

119119 base

120120 , random

121− , uuid

121+ , uuid-bench

122122

123123 -- deps w/o inherited constraints

124124 build-depends:

uuid-types/src/Data/UUID/Types/Internal.hs+1−3

@@ -46,13 +46,11 @@ module Data.UUID.Types.Internal

4646

4747import Prelude hiding (null)

4848

49−import Control.Applicative ((<*>))

5049import Control.DeepSeq (NFData (..))

5150import Control.Monad (guard, liftM2)

5251import Data.Bits

5352import Data.Char

5453import Data.Data

55−import Data.Functor ((<$>))

5654import Data.Hashable

5755import Data.List (elemIndices)

5856import Foreign.Ptr (Ptr)

@@ -79,7 +77,7 @@ import Language.Haskell.TH.Syntax (Lift)

7977-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in

8078-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.

8179data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64

82− deriving (Eq, Ord, Typeable)

80+ deriving (Eq, Ord)

8381{-

8482 Prior to uuid-types-1.0.4:

8583 !Word32 !Word32 !Word32 !Word32

uuid-types/uuid-types.cabal+10−6

@@ -1,6 +1,7 @@

11cabal-version: 1.12

22name: uuid-types

33version: 1.0.6

4+x-revision: 2

45copyright:

@@ -18,9 +19,10 @@ tested-with:

1819 || ==9.0.2

1920 || ==9.2.8

2021 || ==9.4.8

21− || ==9.6.5

22− || ==9.8.2

22+ || ==9.6.6

23+ || ==9.8.4

2324 || ==9.10.1

25+ || ==9.12.1

2426

2527synopsis: Type definitions for Universally Unique Identifiers

2628description:

@@ -48,9 +50,9 @@ library

4850 , binary >=0.8.6.0 && <0.9

4951 , bytestring >=0.10.8.2 && <0.13

5052 , deepseq >=1.4.4.0 && <1.6

51− , hashable >=1.4.4.0 && <1.5

53+ , hashable >=1.4.4.0 && <1.6

5254 , random >=1.2.1.2 && <1.3

53− , template-haskell >=2.14.0.0 && <2.23

55+ , template-haskell >=2.14.0.0 && <2.24

5456 , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2

5557

5658 exposed-modules: Data.UUID.Types

@@ -75,6 +77,8 @@ test-suite testuuid

7577 default-language: Haskell2010

7678 other-extensions: ViewPatterns

7779 ghc-options: -Wall

80+ if impl(ghc >= 8.10)

81+ ghc-options: -Wunused-packages

7882

7983 -- inherited constraints

8084 build-depends:

@@ -86,10 +90,10 @@ test-suite testuuid

8690

8791 -- deps w/o inherited constraints

8892 build-depends:

89− QuickCheck >=2.14.2 && <2.15

93+ QuickCheck >=2.14.2 && <2.16

9094 , tasty >=1.4.0.1 && <1.6

9195 , tasty-hunit >=0.10 && <0.11

92− , tasty-quickcheck >=0.10 && <0.11

96+ , tasty-quickcheck >=0.10 && <0.12

9397

9498 if !impl(ghc >=8.4)

9599 build-depends: ghc-byteorder >=4.11 && <4.12

uuid/CHANGES.md+4

@@ -1,3 +1,7 @@

1+1.3.16

2+

3+- Support GHC-8.6.5...9.10.1

4+

151.3.15

26

37- Add (Template Haskell) `Lift UUID` instance

uuid/src/Data/UUID.hs−3

@@ -18,9 +18,6 @@ See <http://tools.ietf.org/html/rfc4122> for the specification.

1818favorite instance of 'System.Random.Random' for faster but insecure

1919generation of UUIDs.

2020

21−* We have an implementation of generating a UUID from the hardware

22−MAC address and current system time in "Data.UUID.V1".

23−

2421* For name-based generation of UUIDs using SHA-1 hashing see

2522"Data.UUID.V5".

2623-}

uuid/src/Data/UUID/Util.hs−11

@@ -3,7 +3,6 @@ module Data.UUID.Util (

33 UnpackedUUID(..)

44 , unpack, pack

55 , version

6− , extractMac

76 , extractTime

87 , setTime

98 ) where

@@ -13,7 +12,6 @@ import Data.Word

1312import Data.Word.Util

1413import Data.Bits

1514import Data.UUID.Types.Internal

16−import Network.Info

1715import Data.Int (Int64)

1816

1917version :: UUID -> Int

@@ -42,12 +40,3 @@ extractTime uuid =

4240

4341timeAndVersionToTime :: Word16 -> Word16

4442timeAndVersionToTime tv = tv .&. 0x0FFF

45−

46−extractMac :: UUID -> Maybe MAC

47−extractMac uuid =

48− if version uuid == 1

49− then Just $

50− MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked)

51− else Nothing

52− where

53− unpacked = unpack uuid

uuid/src/Data/UUID/V1.hsdeleted−135

@@ -1,135 +0,0 @@

1−{-# OPTIONS_GHC -fno-cse #-}

2−{-# LANGUAGE TypeFamilies #-}

3−

4−{- |

5−Module : Data.UUID.V1

9−

10−License : BSD-style

11−

12−Maintainer : aslatter@gmail.com

13−Stability : experimental

14−Portability : portable

15−

16−RFC 4122 Version 1 UUID state machine.

17−

18−The generated UUID is based on the hardware MAC

19−address and the system clock.

20−

21−If we cannot lookup the MAC address we seed the

22−generator with a pseudo-random number.

23−-}

24−

25−module Data.UUID.V1(nextUUID)

26−where

27−

28−

29−import Data.Bits

30−import Data.Maybe

31−import Data.Time

32−import Data.Word

33−

34−import Control.Applicative ((<$>),(<*>))

35−import Control.Concurrent.MVar

36−import System.IO.Unsafe

37−

38−import qualified System.Random as R

39−

40−import Network.Info

41−

42−import Data.UUID.Types.Internal.Builder

43−import Data.UUID.Types.Internal

44−

45−-- | Returns a new UUID derived from the local hardware MAC

46−-- address and the current system time.

47−-- Is generated according to the Version 1 UUID specified in

48−-- RFC 4122.

49−--

50−-- Returns 'Nothing' if you request UUIDs too quickly.

51−nextUUID :: IO (Maybe UUID)

52−nextUUID = do

53− res <- stepTime

54− case res of

55− Just (mac', c, t) -> return $ Just $ makeUUID t c mac'

56− _ -> return Nothing

57−

58−

59−makeUUID :: Word64 -> Word16 -> MAC -> UUID

60−makeUUID time clock mac' =

61− buildFromBytes 1 /-/ tLow /-/ tMid /-/ tHigh /-/ clock /-/ (MACSource mac')

62− where tLow = (fromIntegral time) :: Word32

63− tMid = (fromIntegral (time `shiftR` 32)) :: Word16

64− tHigh = (fromIntegral (time `shiftR` 48)) :: Word16

65−

66−newtype MACSource = MACSource MAC

67−instance ByteSource MACSource where

68− z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f

69−type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)

70−

71−

72−-- |Approximates the clock algorithm in RFC 4122, section 4.2

73−-- Isn't system wide or thread safe, nor does it properly randomize

74−-- the clock value on initialization.

75−stepTime :: IO (Maybe (MAC, Word16, Word64))

76−stepTime = do

77− h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime

78− modifyMVar state $ \s@(State mac' c0 h0) ->

79− if h1 > h0

80− then

81− return (State mac' c0 h1, Just (mac', c0, h1))

82− else

83− let

84− c1 = succ c0

85− in if c1 <= 0x3fff -- when clock is initially randomized,

86− -- then this test will need to change

87− then

88− return (State mac' c1 h1, Just (mac', c1, h1))

89− else

90− return (s, Nothing)

91−

92−

93−{-# NOINLINE state #-}

94−state :: MVar State

95−state = unsafePerformIO $ do

96− h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime

97− mac' <- getMac

98− newMVar $ State mac' 0 h0 -- the 0 should be a random number

99−

100−-- SysMAC.mac can fail on some machines.

101−-- In those cases we fake it with a random

102−-- 6 bytes seed.

103−getMac :: IO MAC

104−getMac =

105− getNetworkInterfaces >>=

106− return . listToMaybe . filter (minBound /=) . map mac >>=

107− \macM -> case macM of

108− Just m -> return m

109− Nothing -> randomMac

110−

111−randomMac :: IO MAC

112−randomMac =

113− -- I'm too lazy to thread through

114− -- the random state ...

115− MAC

116− <$> (R.randomIO >>= return . (1 .|.)) -- We must set the multicast bit to True. See section 4.5 of the RFC.

117− <*> R.randomIO

118− <*> R.randomIO

119− <*> R.randomIO

120− <*> R.randomIO

121− <*> R.randomIO

122−

123−data State = State

124− {-# UNPACK #-} !MAC

125− {-# UNPACK #-} !Word16

126− {-# UNPACK #-} !Word64

127− deriving (Show)

128−

129−

130−

131−hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64

132−hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt

133− where

134− gregorianReform = UTCTime (fromGregorian 1582 10 15) 0

135− dt = t `diffUTCTime` gregorianReform

uuid/tests/TestUUID.hs+4−20

@@ -1,18 +1,15 @@

11{-# LANGUAGE ViewPatterns #-}

22

3−import Control.Monad (replicateM)

43import Data.Bits

54import qualified Data.ByteString.Lazy as BL

65import Data.Char (ord)

7−import Data.List (nub, (\\))

86import Data.Maybe

97import Data.Word

108import qualified Data.UUID as U

11−import qualified Data.UUID.V1 as U

129import qualified Data.UUID.V3 as U3

1310import qualified Data.UUID.V5 as U5

1411

15−import Test.QuickCheck ( Arbitrary(arbitrary), choose )

12+import Test.QuickCheck ( Arbitrary(arbitrary) )

1613import Test.Tasty ( TestTree, testGroup, defaultMain )

1714import Test.Tasty.HUnit

1815 ( assertBool, (@?=), testCase )

@@ -24,13 +21,13 @@ isValidVersion :: Int -> U.UUID -> Bool

2421isValidVersion v u = lenOK && variantOK && versionOK

2522 where bs = U.toByteString u

2623 lenOK = BL.length bs == 16

27− variantOK = (BL.index bs 8) .&. 0xc0 == 0x80

28− versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)

24+ variantOK = BL.index bs 8 .&. 0xc0 == 0x80

25+ versionOK = BL.index bs 6 .&. 0xf0 == fromIntegral (v `shiftL` 4)

2926

3027

3128instance Arbitrary U.UUID where

3229 -- the UUID random instance ignores bounds

33− arbitrary = choose (U.nil, U.nil)

30+ arbitrary = pure U.nil

3431

3532

3633test_null :: Test

@@ -38,17 +35,6 @@ test_null =

3835 testCase "namespaceDNS is not null" $

3936 assertBool "" (not $ U.null U3.namespaceDNS)

4037

41−test_v1 :: [Maybe U.UUID] -> Test

42−test_v1 v1s = testGroup "version 1" [

43− testCase "V1 unique" $ nub (v1s \\ nub v1s) @?= [],

44− testGroup "V1 not null" $ map (testUUID (not . U.null)) v1s,

45− testGroup "V1 valid" $ map (testUUID (isValidVersion 1)) v1s

46− ]

47− where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test

48− testUUID p u =

49− testCase (show u) $

50− assertBool "" $ maybe False p u

51−

5238test_v3 :: Test

5339test_v3 =

5440 testCase "V3 computation" $

@@ -93,13 +79,11 @@ prop_v5Valid = testProperty "V5 valid" v5Valid

9379

9480main :: IO ()

9581main = do

96− v1s <- replicateM 100 U.nextUUID

9782 defaultMain $

9883 testGroup "tests" $

9984 concat $

10085 [ [

10186 test_null,

102− test_v1 v1s,

10387 test_v3,

10488 test_v5

10589 ]

uuid/uuid.cabal+11−10

@@ -1,6 +1,7 @@

11cabal-version: 1.12

22name: uuid

33version: 1.3.16

4+x-revision: 2

56author: Antoine Latter

67maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>

@@ -15,8 +16,10 @@ tested-with:

1516 || ==9.0.2

1617 || ==9.2.8

1718 || ==9.4.8

18− || ==9.6.5

19− || ==9.8.2

19+ || ==9.6.6

20+ || ==9.8.4

21+ || ==9.10.1

22+ || ==9.12.1

2023

2124synopsis:

2225 For creating, comparing, parsing and printing Universally Unique Identifiers

@@ -44,10 +47,6 @@ library

4447 , cryptohash-md5 >=0.11.100 && <0.12

4548 , cryptohash-sha1 >=0.11.100 && <0.12

4649 , entropy >=0.3.7 && <0.5

47− , network-info >=0.2 && <0.3

48− , random >=1.2.1.2 && <1.3

49− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2

50− , time >=1.4 && <1.13

5150

5251 -- strict dependency on uuid-types,

5352 -- as we re-rexport datatype, thus leak instances etc.

@@ -55,7 +54,6 @@ library

5554 exposed-modules:

5655 Data.UUID

5756 Data.UUID.Util

58− Data.UUID.V1

5957 Data.UUID.V3

6058 Data.UUID.V4

6159 Data.UUID.V5

@@ -68,6 +66,8 @@ library

6866 default-extensions: DeriveDataTypeable

6967 other-extensions: TypeFamilies

7068 ghc-options: -Wall

69+ if impl(ghc >= 8.10)

70+ ghc-options: -Wunused-packages

7171 hs-source-dirs: src

7272

7373test-suite testuuid

@@ -78,17 +78,18 @@ test-suite testuuid

7878 default-extensions: DeriveDataTypeable

7979 other-extensions: ViewPatterns

8080 ghc-options: -Wall -fno-warn-orphans

81+ if impl(ghc >= 8.10)

82+ ghc-options: -Wunused-packages

8183

8284 -- inherited constraints

8385 build-depends:

8486 base

8587 , bytestring

86− , random

8788 , uuid

8889

8990 -- deps w/o inherited constraints

9091 build-depends:

91− QuickCheck >=2.14.2 && <2.15

92+ QuickCheck >=2.14.2 && <2.16

9293 , tasty >=1.4.0.1 && <1.6

9394 , tasty-hunit >=0.10 && <0.11

94− , tasty-quickcheck >=0.10 && <0.11

95+ , tasty-quickcheck >=0.10 && <0.12