master..12641b7 · typeable/uuid

.git-blame-ignore-revsdeleted−2

since splitsnapshots

unifiedsplit

@@ -1,2 +0,0 @@

1−# Move code into subdirectories

2−bf1ac1bad848bb2c081f0cae1631bf53811ec05a

.github/workflows/haskell-ci-bench.ymldeleted−241

@@ -1,241 +0,0 @@

1−# This GitHub workflow config has been generated by a script via

2−#

3−# haskell-ci 'github' '--project' 'cabal.bench.project' '-o' '.github/workflows/haskell-ci-bench.yml' '--github-action-name' 'Benchmarks'

4−#

5−# To regenerate the script (for example after adjusting tested-with) run

6−#

7−# haskell-ci regenerate

8−#

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

10−#

11−# version: 0.19.20240702

12−#

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

14−#

15−name: Benchmarks

16−on:

17− push:

18− branches:

19− - master

20− pull_request:

21− branches:

22− - master

23−jobs:

24− linux:

25− name: Benchmarks - Linux - ${{ matrix.compiler }}

26− runs-on: ubuntu-20.04

27− timeout-minutes:

28− 60

29− container:

30− image: buildpack-deps:jammy

31− continue-on-error: ${{ matrix.allow-failure }}

32− strategy:

33− matrix:

34− include:

35− - compiler: ghc-9.10.1

36− compilerKind: ghc

37− compilerVersion: 9.10.1

38− setup-method: ghcup

39− allow-failure: false

40− - compiler: ghc-9.8.2

41− compilerKind: ghc

42− compilerVersion: 9.8.2

43− setup-method: ghcup

44− allow-failure: false

45− - compiler: ghc-9.6.6

46− compilerKind: ghc

47− compilerVersion: 9.6.6

48− setup-method: ghcup

49− allow-failure: false

50− - compiler: ghc-9.4.8

51− compilerKind: ghc

52− compilerVersion: 9.4.8

53− setup-method: ghcup

54− allow-failure: false

55− - compiler: ghc-9.2.8

56− compilerKind: ghc

57− compilerVersion: 9.2.8

58− setup-method: ghcup

59− allow-failure: false

60− - compiler: ghc-9.0.2

61− compilerKind: ghc

62− compilerVersion: 9.0.2

63− setup-method: ghcup

64− allow-failure: false

65− - compiler: ghc-8.10.7

66− compilerKind: ghc

67− compilerVersion: 8.10.7

68− setup-method: ghcup

69− allow-failure: false

70− - compiler: ghc-8.8.4

71− compilerKind: ghc

72− compilerVersion: 8.8.4

73− setup-method: ghcup

74− allow-failure: false

75− - compiler: ghc-8.6.5

76− compilerKind: ghc

77− compilerVersion: 8.6.5

78− setup-method: ghcup

79− allow-failure: false

80− fail-fast: false

81− steps:

82− - name: apt

83− run: |

84− apt-get update

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

86− 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"

88− chmod a+x "$HOME/.ghcup/bin/ghcup"

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

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

91− env:

92− HCKIND: ${{ matrix.compilerKind }}

93− HCNAME: ${{ matrix.compiler }}

94− HCVER: ${{ matrix.compilerVersion }}

95− - name: Set PATH and environment variables

96− run: |

97− echo "$HOME/.cabal/bin" >> $GITHUB_PATH

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

99− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"

100− 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.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"

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

110− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

111− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

112− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

113− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"

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

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

116− env:

117− HCKIND: ${{ matrix.compilerKind }}

118− HCNAME: ${{ matrix.compiler }}

119− HCVER: ${{ matrix.compilerVersion }}

120− - name: env

121− run: |

122− env

123− - name: write cabal config

124− run: |

125− mkdir -p $CABAL_DIR

126− cat >> $CABAL_CONFIG <<EOF

127− remote-build-reporting: anonymous

128− write-ghc-environment-files: never

129− remote-repo-cache: $CABAL_DIR/packages

130− logs-dir: $CABAL_DIR/logs

131− world-file: $CABAL_DIR/world

132− extra-prog-path: $CABAL_DIR/bin

133− symlink-bindir: $CABAL_DIR/bin

134− installdir: $CABAL_DIR/bin

135− build-summary: $CABAL_DIR/logs/build.log

136− store-dir: $CABAL_DIR/store

137− install-dirs user

138− prefix: $CABAL_DIR

139− repository hackage.haskell.org

140− url: http://hackage.haskell.org/

141− EOF

142− cat >> $CABAL_CONFIG <<EOF

143− program-default-options

144− ghc-options: $GHCJOBS +RTS -M3G -RTS

145− EOF

146− cat $CABAL_CONFIG

147− - name: versions

148− run: |

149− $HC --version || true

150− $HC --print-project-git-commit-id || true

151− $CABAL --version || true

152− - name: update cabal index

153− run: |

154− $CABAL v2-update -v

155− - name: install cabal-plan

156− run: |

157− mkdir -p $HOME/.cabal/bin

158− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz

159− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -

160− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan

161− rm -f cabal-plan.xz

162− chmod a+x $HOME/.cabal/bin/cabal-plan

163− cabal-plan --version

164− - name: checkout

165− uses: actions/checkout@v4

166− with:

167− path: source

168− - name: initial cabal.project for sdist

169− run: |

170− touch cabal.project

171− echo "packages: $GITHUB_WORKSPACE/source/uuid-bench" >> cabal.project

172− cat cabal.project

173− - name: sdist

174− run: |

175− mkdir -p sdist

176− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist

177− - name: unpack

178− run: |

179− mkdir -p unpacked

180− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;

181− - name: generate cabal.project

182− run: |

183− PKGDIR_uuid_bench="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-bench-[0-9.]*')"

184− echo "PKGDIR_uuid_bench=${PKGDIR_uuid_bench}" >> "$GITHUB_ENV"

185− rm -f cabal.project cabal.project.local

186− touch cabal.project

187− touch cabal.project.local

188− echo "packages: ${PKGDIR_uuid_bench}" >> cabal.project

189− echo "package uuid-bench" >> cabal.project

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

191− cat >> cabal.project <<EOF

192− EOF

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

194− cat cabal.project

195− cat cabal.project.local

196− - name: dump install plan

197− run: |

198− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all

199− cabal-plan

200− - name: restore cache

201− uses: actions/cache/restore@v4

202− with:

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

204− path: ~/.cabal/store

205− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-

206− - name: install dependencies

207− run: |

208− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all

209− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all

210− - name: build w/o tests

211− run: |

212− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

213− - name: build

214− run: |

215− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always

216− - name: cabal check

217− run: |

218− cd ${PKGDIR_uuid_bench} || false

219− ${CABAL} -vnormal check

220− - name: haddock

221− run: |

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

223− - name: unconstrained build

224− run: |

225− rm -f cabal.project.local

226− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

227− - name: prepare for constraint sets

228− run: |

229− rm -f cabal.project.local

230− - name: constraint set random-1.2

231− run: |

232− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all --dry-run

233− cabal-plan topo | sort

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

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

236− - name: save cache

237− uses: actions/cache/save@v4

238− if: always()

239− with:

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

241− path: ~/.cabal/store

.github/workflows/haskell-ci.ymldeleted−262

@@ -1,262 +0,0 @@

1−# This GitHub workflow config has been generated by a script via

2−#

3−# haskell-ci 'github' 'cabal.project'

4−#

5−# To regenerate the script (for example after adjusting tested-with) run

6−#

7−# haskell-ci regenerate

8−#

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

10−#

11−# version: 0.19.20241223

12−#

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

14−#

15−name: Haskell-CI

16−on:

17− push:

18− branches:

19− - master

20− pull_request:

21− branches:

22− - master

23−jobs:

24− linux:

25− name: Haskell-CI - Linux - ${{ matrix.compiler }}

26− runs-on: ubuntu-20.04

27− timeout-minutes:

28− 60

29− container:

30− image: buildpack-deps:jammy

31− continue-on-error: ${{ matrix.allow-failure }}

32− strategy:

33− matrix:

34− include:

35− - compiler: ghc-9.12.1

36− compilerKind: ghc

37− compilerVersion: 9.12.1

38− setup-method: ghcup

39− allow-failure: false

40− - compiler: ghc-9.10.1

41− compilerKind: ghc

42− compilerVersion: 9.10.1

43− setup-method: ghcup

44− allow-failure: false

45− - compiler: ghc-9.8.4

46− compilerKind: ghc

47− compilerVersion: 9.8.4

48− setup-method: ghcup

49− allow-failure: false

50− - compiler: ghc-9.6.6

51− compilerKind: ghc

52− compilerVersion: 9.6.6

53− setup-method: ghcup

54− allow-failure: false

55− - compiler: ghc-9.4.8

56− compilerKind: ghc

57− compilerVersion: 9.4.8

58− setup-method: ghcup

59− allow-failure: false

60− - compiler: ghc-9.2.8

61− compilerKind: ghc

62− compilerVersion: 9.2.8

63− setup-method: ghcup

64− allow-failure: false

65− - compiler: ghc-9.0.2

66− compilerKind: ghc

67− compilerVersion: 9.0.2

68− setup-method: ghcup

69− allow-failure: false

70− - compiler: ghc-8.10.7

71− compilerKind: ghc

72− compilerVersion: 8.10.7

73− setup-method: ghcup

74− allow-failure: false

75− - compiler: ghc-8.8.4

76− compilerKind: ghc

77− compilerVersion: 8.8.4

78− setup-method: ghcup

79− allow-failure: false

80− - compiler: ghc-8.6.5

81− compilerKind: ghc

82− compilerVersion: 8.6.5

83− setup-method: ghcup

84− allow-failure: false

85− fail-fast: false

86− steps:

87− - name: apt-get install

88− run: |

89− apt-get update

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

91− - name: Install GHCup

92− run: |

93− mkdir -p "$HOME/.ghcup/bin"

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

95− 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: |

103− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (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"

110− env:

111− HCKIND: ${{ matrix.compilerKind }}

112− HCNAME: ${{ matrix.compiler }}

113− HCVER: ${{ matrix.compilerVersion }}

114− - name: Set PATH and environment variables

115− run: |

116− echo "$HOME/.cabal/bin" >> $GITHUB_PATH

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

118− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"

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

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

121− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

122− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

123− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

124− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"

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

126− env:

127− HCKIND: ${{ matrix.compilerKind }}

128− HCNAME: ${{ matrix.compiler }}

129− HCVER: ${{ matrix.compilerVersion }}

130− - name: env

131− run: |

132− env

133− - name: write cabal config

134− run: |

135− mkdir -p $CABAL_DIR

136− cat >> $CABAL_CONFIG <<EOF

137− remote-build-reporting: anonymous

138− write-ghc-environment-files: never

139− remote-repo-cache: $CABAL_DIR/packages

140− logs-dir: $CABAL_DIR/logs

141− world-file: $CABAL_DIR/world

142− extra-prog-path: $CABAL_DIR/bin

143− symlink-bindir: $CABAL_DIR/bin

144− installdir: $CABAL_DIR/bin

145− build-summary: $CABAL_DIR/logs/build.log

146− store-dir: $CABAL_DIR/store

147− install-dirs user

148− prefix: $CABAL_DIR

149− repository hackage.haskell.org

150− url: http://hackage.haskell.org/

151− EOF

152− cat >> $CABAL_CONFIG <<EOF

153− program-default-options

154− ghc-options: $GHCJOBS +RTS -M3G -RTS

155− EOF

156− cat $CABAL_CONFIG

157− - name: versions

158− run: |

159− $HC --version || true

160− $HC --print-project-git-commit-id || true

161− $CABAL --version || true

162− - name: update cabal index

163− run: |

164− $CABAL v2-update -v

165− - name: install cabal-plan

166− run: |

167− mkdir -p $HOME/.cabal/bin

168− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz

169− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -

170− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan

171− rm -f cabal-plan.xz

172− chmod a+x $HOME/.cabal/bin/cabal-plan

173− cabal-plan --version

174− - name: checkout

175− uses: actions/checkout@v4

176− with:

177− path: source

178− - name: initial cabal.project for sdist

179− run: |

180− touch cabal.project

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

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

183− cat cabal.project

184− - name: sdist

185− run: |

186− mkdir -p sdist

187− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist

188− - name: unpack

189− run: |

190− mkdir -p unpacked

191− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;

192− - name: generate cabal.project

193− run: |

194− PKGDIR_uuid_types="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-types-[0-9.]*')"

195− echo "PKGDIR_uuid_types=${PKGDIR_uuid_types}" >> "$GITHUB_ENV"

196− PKGDIR_uuid="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-[0-9.]*')"

197− echo "PKGDIR_uuid=${PKGDIR_uuid}" >> "$GITHUB_ENV"

198− rm -f cabal.project cabal.project.local

199− touch cabal.project

200− touch cabal.project.local

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

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

203− echo "package uuid-types" >> cabal.project

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

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

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

207− cat >> cabal.project <<EOF

208− EOF

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

210− cat cabal.project

211− cat cabal.project.local

212− - name: dump install plan

213− run: |

214− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all

215− cabal-plan

216− - name: restore cache

217− uses: actions/cache/restore@v4

218− with:

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

220− path: ~/.cabal/store

221− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-

222− - name: install dependencies

223− run: |

224− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all

225− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all

226− - name: build w/o tests

227− run: |

228− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

229− - name: build

230− run: |

231− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always

232− - name: tests

233− run: |

234− $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct

235− - name: cabal check

236− run: |

237− cd ${PKGDIR_uuid_types} || false

238− ${CABAL} -vnormal check

239− cd ${PKGDIR_uuid} || false

240− ${CABAL} -vnormal check

241− - name: haddock

242− run: |

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

244− - name: unconstrained build

245− run: |

246− rm -f cabal.project.local

247− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

248− - name: prepare for constraint sets

249− run: |

250− rm -f cabal.project.local

251− - name: constraint set random-1.2

252− run: |

253− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all --dry-run

254− cabal-plan topo | sort

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

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

257− - name: save cache

258− if: always()

259− uses: actions/cache/save@v4

260− with:

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

262− path: ~/.cabal/store

.gitignore+5−9

@@ -1,13 +1,9 @@

1+

1# Sandboxing

2# Sandboxing

2−.cabal-sandbox/

3+/.cabal-sandbox/

3−cabal.sandbox.config

4+/cabal.sandbox.config

4

5

5# Cabal stuff

6# Cabal stuff

6−dist/

7+/dist/

7−cabal.config

8+/cabal.config

8−dist-newstyle/

9−/cabal.project.local

10−.ghc.environment.*

11

9

12−# Emacs

13−*~

.travis.ymlnew file+7

@@ -0,0 +1,7 @@

1+language: haskell

2+ghc:

3+ - 7.8

4+ - 7.6

5+ - 7.4

6+

7+sudo: false

CHANGESnew file+141

@@ -0,0 +1,141 @@

1+1.3.8

2+

3+- Allow building against newer deepseq.

4+

5+1.3.7

6+

7+- Allow building against newer time.

8+

9+1.3.6

10+

11+- Move to GitHub.

12+

13+1.3.5

14+

15+- Allow building against newer random.

16+

17+1.3.4

18+

19+- Allow building against newer QuickCheck.

20+

21+1.3.3

22+

23+- More complex version constrainsts on hashable, to avoid building against

24+ versions less than 1.1.1.0 or equal to 1.2.0.*.

25+

26+1.3.2

27+

28+- Fix for building against bytestring 0.9.*

29+

30+1.3.1

31+

32+- Allow building against 'hashable' 1.1.* in addition to 1.2.*

33+

34+1.3.0

35+

36+- New functions for parsing and printing UUIDs to and from ASCII BytesStrings

37+- New module Data.UUID.Util. This module includes the type 'UnpackedUUID',

38+ whose fields correspond to the UUID fields described in RFC 4122.

39+- The Storable instance now stores a UUID in host byte-order instead of

40+ big endian.

41+- There is now an instance for 'Hashable UUID'.

42+

43+1.2.13

44+

45+Benchmark only changes:

46+

47+- Allow criterion 0.8.*

48+

49+1.2.12

50+

51+Test only changes:

52+

53+- Allow QuickCheck 2.6.*

54+

55+1.2.11

56+

57+- Allow binary 0.7.*

58+

59+1.2.10

60+

61+- Allow cryptohash version 0.9.*

62+- Cleanup tests

63+

64+1.2.9

65+

66+- Bumped dependency on 'cryptohash'.

67+

68+1.2.8

69+

70+- Bumped various dependencies and cleaned up dependencies in general.

71+

72+1.2.7

73+

74+- Added stricter constraints on 'random' package.

75+

76+1.2.6

77+

78+- Add module 'V4' to direct attention to our Random instance

79+

80+- In module 'V1' seed the generator with a random number

81+ if the hardware MAC address could not be discovered.

82+

83+- Fix and cleanup various haddocks.

84+

85+- In module docs, warn about MD5 use in Data.UUID.V3 and

86+ encourage the reader to use Data.UUID.V5 instead.

87+

88+1.2.5

89+

90+- Use 'cryptohash' package for MD5 and SHA1 instead of 'Crypto'

91+

92+1.2.4

93+

94+- Unpack Word32 values into UUID constructor.

95+

96+- Update test suite to QuickCheck 2

97+

98+- Bump other dependencies in tests/benchmarks

99+

100+1.2.3

101+

102+- The Read instance now drops leading spaces in the string to be parsed.

103+Thanks to Marc Ziegert for reporting this bug.

104+

105+- The tests have moved over to the new Cabal test running framework.

106+

107+1.2.2

108+

109+- Add functions fromWords/toWords

110+

111+The goal was to have a total function that can be used to construct

112+a UUID, primarily for use by uuid-th.

113+

114+1.2.1

115+

116+- Fix concurrency bug in Data.UUID.V1 (thanks to Neil Mitchell for reporting

117+and a test case)

118+

119+1.2.0

120+ (Contributors: Antoine Latter & Mark Lentczner)

121+

122+- added functions toByteString and fromByteString

123+- added 'nil' UUID

124+- added unit tests and benchmarks, built when configured -ftest

125+- major speed up of to/from functions (as well as in general)

126+- added version-3 generation (deterministic based on MD5)

127+- major changes to internal representation

128+ - now uses four strict Word32 values

129+ - internal ByteSource classes for easy construction (see Builder.hs)

130+- Storable instance now stores in memory as system libraries in C do:

131+ 16 bytes derived from the network order of the fields, no matter what

132+ the host native endianess is.

133+- fixed bugs in V1 time and clock stepping, and V1 generated values

134+- builds cleanly under GHC's -Wall

135+- added CHANGES file

136+

137+1.1.1

138+

139+- no longer exporting 'null' from the prelude

140+- add 'null' predicate on UUIDs

141+- documentation fix (thanks Mark Lentczner)

CONTRIBUTORS+1−4

@@ -9,7 +9,4 @@ Bas van Dijk

9Sergei Trofimovich

10davean

11Francesco Mazzoli

12−Michael Snoyman

12+Michael Snoyman

13−Bardur Arantsson

14−Timo von Holtz

15−Oleg Grenrus

uuid/src/Data/UUID.hs → Data/UUID.hsrenamed+10−12

@@ -14,18 +14,19 @@ printing Universally Unique Identifiers.

14See <http://en.wikipedia.org/wiki/UUID> for the general idea.

15See <http://tools.ietf.org/html/rfc4122> for the specification.

16

17−* Use 'Data.UUID.V4.nextRandom' to generate secure random UUIDs, and your

17+* Random UUIDs may be generated using 'Data.UUID.V4.nextRandom' or

18−favorite instance of 'System.Random.Random' for faster but insecure

18+your favorite instance of 'System.Random.Random'.

19−generation of UUIDs.

19+

20+* We have an implementation of generating a UUID from the hardware

21+MAC address and current system time in "Data.UUID.V1".

20

22

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

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

22"Data.UUID.V5".

24"Data.UUID.V5".

23-}

25-}

26+

24module Data.UUID(UUID

27module Data.UUID(UUID

25 ,toString

28 ,toString

26 ,fromString

29 ,fromString

27− ,toText

28− ,fromText

29 ,toASCIIBytes

30 ,toASCIIBytes

30 ,fromASCIIBytes

31 ,fromASCIIBytes

31 ,toLazyASCIIBytes

32 ,toLazyASCIIBytes

@@ -34,16 +35,13 @@ module Data.UUID(UUID

34 ,fromByteString

35 ,fromByteString

35 ,toWords

36 ,toWords

36 ,fromWords

37 ,fromWords

37− ,toWords64

38− ,fromWords64

39 ,null

38 ,null

40 ,nil

39 ,nil

41 ) where

40 ) where

42

41

43import Prelude () -- we need to hide Prelude.null

42import Prelude () -- we need to hide Prelude.null

44−import Data.UUID.Types

43+import Data.UUID.Internal

45

44

46−-- We use explicit re-exports of everything from Data.UUID.Types in

45+-- Everything is really implemented in Data.UUID.Internal,

47−-- preference to just re-exporting the whole module. This is to avoid

46+-- but I don't want to export the constructors out of the

48−-- unforeseen transitive API breakage if the Data.UUID.Types module

47+-- package.

49−-- should change.

uuid-types/src/Data/UUID/Types/Internal/Builder.hs → Data/UUID/Builder.hsrenamed+2−18

@@ -1,9 +1,6 @@

1{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE Unsafe #-}

3

2

4−{-# OPTIONS_HADDOCK hide #-}

5−

6−-- | Module : Data.UUID.Types.Internal.Builder

3+-- Module : Data.UUID.Builder

8--

5--

9-- License : BSD-style

6-- License : BSD-style

@@ -31,7 +28,7 @@

31-- code was ungainly. Using this module makes the code very

28-- code was ungainly. Using this module makes the code very

32-- concise, and turns out to optimize to just as fast, or faster!

29-- concise, and turns out to optimize to just as fast, or faster!

33

30

34−module Data.UUID.Types.Internal.Builder

31+module Data.UUID.Builder

35 (ByteSource(..)

32 (ByteSource(..)

36 ,ByteSink

33 ,ByteSink

37 ,Takes1Byte

34 ,Takes1Byte

@@ -49,7 +46,6 @@ type Takes1Byte g = Word8 -> g

49type Takes2Bytes g = Word8 -> Word8 -> g

46type Takes2Bytes g = Word8 -> Word8 -> g

50type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g

47type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g

51type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g

48type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g

52−type Takes8Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> g

53

49

54-- | Type of function that a given ByteSource needs.

50-- | Type of function that a given ByteSource needs.

55-- This function must take as many Word8 arguments as the ByteSource provides

51-- This function must take as many Word8 arguments as the ByteSource provides

@@ -57,7 +53,6 @@ type family ByteSink w g

57type instance ByteSink Word8 g = Takes1Byte g

53type instance ByteSink Word8 g = Takes1Byte g

58type instance ByteSink Word16 g = Takes2Bytes g

54type instance ByteSink Word16 g = Takes2Bytes g

59type instance ByteSink Word32 g = Takes4Bytes g

55type instance ByteSink Word32 g = Takes4Bytes g

60−type instance ByteSink Word64 g = Takes8Bytes g

61type instance ByteSink Int g = Takes4Bytes g

56type instance ByteSink Int g = Takes4Bytes g

62

57

63

58

@@ -85,17 +80,6 @@ instance ByteSource Word32 where

85 b3 = fromIntegral (w `shiftR` 8)

80 b3 = fromIntegral (w `shiftR` 8)

86 b4 = fromIntegral w

81 b4 = fromIntegral w

87

82

88−instance ByteSource Word64 where

89− f /-/ w = f b1 b2 b3 b4 b5 b6 b7 b8

90− where b1 = fromIntegral (w `shiftR` 56)

91− b2 = fromIntegral (w `shiftR` 48)

92− b3 = fromIntegral (w `shiftR` 40)

93− b4 = fromIntegral (w `shiftR` 32)

94− b5 = fromIntegral (w `shiftR` 24)

95− b6 = fromIntegral (w `shiftR` 16)

96− b7 = fromIntegral (w `shiftR` 8)

97− b8 = fromIntegral w

98−

99instance ByteSource Int where

83instance ByteSource Int where

100 f /-/ w = f b1 b2 b3 b4

84 f /-/ w = f b1 b2 b3 b4

101 where b1 = fromIntegral (w `shiftR` 24)

85 where b1 = fromIntegral (w `shiftR` 24)

uuid-types/src/Data/UUID/Types/Internal.hs → Data/UUID/Internal.hsrenamed+169−208

@@ -1,86 +1,83 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveDataTypeable #-}

1+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}

3−{-# LANGUAGE TypeFamilies #-}

4−{-# LANGUAGE ViewPatterns #-}

5−{-# LANGUAGE Unsafe #-}

6−{-# LANGUAGE DeriveLift #-}

7−{-# LANGUAGE StandaloneDeriving #-}

8−{-# OPTIONS_HADDOCK hide #-}

9

2

10-- |

3-- |

11−-- Module : Data.UUID.Types.Internal

4+-- Module : Data.UUID

15--

7--

16-- License : BSD-style

8-- License : BSD-style

17--

9--

18−-- Maintainer : hvr@gnu.org

10+-- Maintainer : aslatter@gmail.com

11+-- Stability : experimental

19-- Portability : portable

12-- Portability : portable

20

13

21−module Data.UUID.Types.Internal

14+module Data.UUID.Internal

22− ( UUID(..)

15+ (UUID(..)

23− , null

16+ ,null

24− , nil

17+ ,nil

25− , fromByteString

18+ ,fromByteString

26− , toByteString

19+ ,toByteString

27− , fromString

20+ ,fromString

28− , toString

21+ ,toString

29− , fromText

30− , toText

31− , fromWords

22+ ,fromWords

32− , toWords

23+ ,toWords

33− , fromWords64

34− , toWords64

35− , toList

24+ ,toList

36− , buildFromBytes

25+ ,buildFromBytes

37− , buildFromWords

26+ ,buildFromWords

38− , fromASCIIBytes

27+ ,fromASCIIBytes

39− , toASCIIBytes

28+ ,toASCIIBytes

40− , fromLazyASCIIBytes

29+ ,fromLazyASCIIBytes

41− , toLazyASCIIBytes

30+ ,toLazyASCIIBytes

42− , UnpackedUUID(..)

31+ ,UnpackedUUID(..)

43− , pack

32+ ,pack

44− , unpack

33+ ,unpack

45 ) where

34 ) where

46

35

47−import Prelude hiding (null)

36+import Prelude hiding (null)

48−

37+

38+import Control.Applicative ((<*>))

49−import Control.DeepSeq (NFData (..))

39+import Control.DeepSeq (NFData(..))

50−import Control.Monad (guard, liftM2)

40+import Control.Monad (liftM4, guard)

41+import Data.Functor ((<$>))

42+import Data.Char

51−import Data.Bits

43+import Data.Bits

52−import Data.Char

53−import Data.Data

54−import Data.Hashable

44+import Data.Hashable

55−import Data.List (elemIndices)

45+import Data.List (elemIndices)

56−import Foreign.Ptr (Ptr)

46+import Foreign.Ptr (Ptr)

57−

47+

48+#if MIN_VERSION_base(4,0,0)

49+import Data.Data

50+#else

51+import Data.Generics.Basics

52+#endif

53+

58−import Foreign.Storable

54+import Foreign.Storable

59−

55+

56+import Data.Binary

60−import Data.Binary

57+import Data.Binary.Put

61−import Data.Binary.Get

58+import Data.Binary.Get

62−import Data.Binary.Put

63−import qualified Data.ByteString as B

59+import qualified Data.ByteString as B

64−import qualified Data.ByteString.Internal as BI

60+import qualified Data.ByteString.Internal as BI

65−import qualified Data.ByteString.Lazy as BL

61+import qualified Data.ByteString.Lazy as BL

66−import qualified Data.ByteString.Unsafe as BU

62+import qualified Data.ByteString.Unsafe as BU

67−import Data.Text (Text)

63+

68−import qualified Data.Text.Encoding as T

69−

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

64+import Data.UUID.Builder

71−

65+

72−import System.Random (Random (..), uniform)

66+import System.Random

73−import System.Random.Stateful (Uniform (..), uniformWord64)

67+

74−

68+

75−import Language.Haskell.TH.Syntax (Lift)

69+-- |The UUID type. A 'Random' instance is provided which produces

76−

70+-- version 4 UUIDs as specified in RFC 4122. The 'Storable' and

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

71+-- 'Binary' instances are compatible with RFC 4122, storing the fields

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

72+-- in network order as 16 bytes.

79−data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64

73+data UUID

74+ = UUID

75+ {-# UNPACK #-} !Word32

76+ {-# UNPACK #-} !Word32

77+ {-# UNPACK #-} !Word32

78+ {-# UNPACK #-} !Word32

80− deriving (Eq, Ord)

79+ deriving (Eq, Ord, Typeable)

81{-

80{-

82− Prior to uuid-types-1.0.4:

83− !Word32 !Word32 !Word32 !Word32

84 Other representations that we tried are:

81 Other representations that we tried are:

85 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16

82 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16

86 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8

83 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8

@@ -92,75 +89,40 @@ data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64

92 None was as fast, overall, as the representation used here.

89 None was as fast, overall, as the representation used here.

93-}

90-}

94

91

95−-- | Convert a 'UUID' into a sequence of 'Word32' values.

92+-- | Covert a 'UUID' into a sequence of 'Word32' values.

96-- Useful for when you need to serialize a UUID and

93-- Useful for when you need to serialize a UUID and

97-- neither 'Storable' nor 'Binary' are appropriate.

94-- neither 'Storable' nor 'Binary' are appropriate.

98−--

95+-- Introduced in version 1.2.2.

99−-- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000"

100−-- Just (1427014656,3801825748,2803254374,1430519808)

101−--

102−-- See also 'toWords64'.

103−--

104−-- /Since: @uuid-1.2.2@/

105−--

106−-- @since 1.0.0

107toWords :: UUID -> (Word32, Word32, Word32, Word32)

96toWords :: UUID -> (Word32, Word32, Word32, Word32)

108−toWords (UUID w12 w34) = (w1, w2, w3, w4)

97+toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)

109− where

110− w1 = fromIntegral (w12 `unsafeShiftR` 32)

111− w2 = fromIntegral w12

112− w3 = fromIntegral (w34 `unsafeShiftR` 32)

113− w4 = fromIntegral w34

114

98

115-- | Create a 'UUID' from a sequence of 'Word32'. The

99-- | Create a 'UUID' from a sequence of 'Word32'. The

116−-- inverse of 'toWords'. Useful when you need a total

100+-- opposite of 'toWords'. Useful when you need a total

117-- function for constructing 'UUID' values.

101-- function for constructing 'UUID' values.

118−--

102+-- Introduced in version 1.2.2.

119−-- See also 'fromWords64'.

120−--

121−-- /Since: @uuid-1.2.2@/

122−--

123−-- @since 1.0.0

124fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

103fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

125−fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)

104+fromWords = UUID

126−

127−-- | Convert a 'UUID' into a pair of 'Word64's.

128−--

129−-- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000"

130−-- Just (6128981282234515924,12039885860129472512)

131−--

132−-- See also 'toWords'.

133−--

134−-- @since 1.0.4

135−toWords64 :: UUID -> (Word64, Word64)

136−toWords64 (UUID w12 w34) = (w12,w34)

137−

138−-- | Create a 'UUID' from a pair of 'Word64's.

139−--

140−-- Inverse of 'toWords64'. See also 'fromWords'.

141−--

142−-- @since 1.0.4

143−fromWords64 :: Word64 -> Word64 -> UUID

144−fromWords64 = UUID

145

105

146data UnpackedUUID =

106data UnpackedUUID =

147 UnpackedUUID {

107 UnpackedUUID {

148− time_low :: Word32 -- 0-3

108+ time_low :: Word32 -- 0-3

149− , time_mid :: Word16 -- 4-5

109+ , time_mid :: Word16 -- 4-5

150 , time_hi_and_version :: Word16 -- 6-7

110 , time_hi_and_version :: Word16 -- 6-7

151− , clock_seq_hi_res :: Word8 -- 8

111+ , clock_seq_hi_res :: Word8 -- 8

152− , clock_seq_low :: Word8 -- 9

112+ , clock_seq_low :: Word8 -- 9

153− , node_0 :: Word8

113+ , node_0 :: Word8

154− , node_1 :: Word8

114+ , node_1 :: Word8

155− , node_2 :: Word8

115+ , node_2 :: Word8

156− , node_3 :: Word8

116+ , node_3 :: Word8

157− , node_4 :: Word8

117+ , node_4 :: Word8

158− , node_5 :: Word8

118+ , node_5 :: Word8

159 }

119 }

160 deriving (Read, Show, Eq, Ord)

120 deriving (Read, Show, Eq, Ord)

161

121

162unpack :: UUID -> UnpackedUUID

122unpack :: UUID -> UnpackedUUID

163−unpack (UUID w0 w1) = build /-/ w0 /-/ w1

123+unpack (UUID w0 w1 w2 w3) =

124+ build /-/ w0 /-/ w1 /-/ w2 /-/ w3

125+

164 where

126 where

165 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =

127 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =

166 UnpackedUUID {

128 UnpackedUUID {

@@ -195,26 +157,23 @@ pack unpacked =

195

157

196-- |Build a Word32 from four Word8 values, presented in big-endian order

158-- |Build a Word32 from four Word8 values, presented in big-endian order

197word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32

159word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32

198−word a b c d = (fromIntegral a `unsafeShiftL` 24)

160+word a b c d = (fromIntegral a `shiftL` 24)

199− .|. (fromIntegral b `unsafeShiftL` 16)

161+ .|. (fromIntegral b `shiftL` 16)

200− .|. (fromIntegral c `unsafeShiftL` 8)

162+ .|. (fromIntegral c `shiftL` 8)

201− .|. (fromIntegral d )

163+ .|. (fromIntegral d )

202

164

203−-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,

165+-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,

204−byte :: Int -> Word64 -> Word8

166+byte :: Int -> Word32 -> Word8

205byte i w = fromIntegral (w `shiftR` (i * 8))

167byte i w = fromIntegral (w `shiftR` (i * 8))

206

168

207-- |Build a Word16 from two Word8 values, presented in big-endian order.

169-- |Build a Word16 from two Word8 values, presented in big-endian order.

208w8to16 :: Word8 -> Word8 -> Word16

170w8to16 :: Word8 -> Word8 -> Word16

209w8to16 w0s w1s =

171w8to16 w0s w1s =

210− (w0 `unsafeShiftL` 8) .|. w1

172+ (w0 `shiftL` 8) .|. w1

211 where

173 where

212 w0 = fromIntegral w0s

174 w0 = fromIntegral w0s

213 w1 = fromIntegral w1s

175 w1 = fromIntegral w1s

214

176

215−-- | Construct 'Word64' from low/high 'Word32's

216−w32to64 :: Word32 -> Word32 -> Word64

217−w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1)

218

177

219-- |Make a UUID from sixteen Word8 values

178-- |Make a UUID from sixteen Word8 values

220makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8

179makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8

@@ -223,12 +182,16 @@ makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8

223 -> Word8 -> Word8 -> Word8 -> Word8

182 -> Word8 -> Word8 -> Word8 -> Word8

224 -> UUID

183 -> UUID

225makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf

184makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf

226− = fromWords w0 w1 w2 w3

185+ = UUID w0 w1 w2 w3

227 where w0 = word b0 b1 b2 b3

186 where w0 = word b0 b1 b2 b3

228 w1 = word b4 b5 b6 b7

187 w1 = word b4 b5 b6 b7

229 w2 = word b8 b9 ba bb

188 w2 = word b8 b9 ba bb

230 w3 = word bc bd be bf

189 w3 = word bc bd be bf

231

190

191+-- |Make a UUID from four Word32 values

192+makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

193+makeFromWords = UUID

194+

232-- |A Builder for constructing a UUID of a given version.

195-- |A Builder for constructing a UUID of a given version.

233buildFromBytes :: Word8

196buildFromBytes :: Word8

234 -> Word8 -> Word8 -> Word8 -> Word8

197 -> Word8 -> Word8 -> Word8 -> Word8

@@ -241,20 +204,20 @@ buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =

241 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)

204 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)

242 b8' = b8 .&. 0x3f .|. 0x80

205 b8' = b8 .&. 0x3f .|. 0x80

243

206

244−-- |Build a UUID of a given version from 'Word32' values.

207+-- |Build a UUID of a given version from Word32 values.

245buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID

208buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID

246−buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3

209+buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3

247 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)

210 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)

248 w2' = w2 .&. 0x3fffffff .|. 0x80000000

211 w2' = w2 .&. 0x3fffffff .|. 0x80000000

249

212

250

213

251-- |Return the bytes that make up the UUID

214-- |Return the bytes that make up the UUID

252toList :: UUID -> [Word8]

215toList :: UUID -> [Word8]

253−toList (UUID w0 w1) =

216+toList (UUID w0 w1 w2 w3) =

254− [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,

217+ [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,

255− byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,

218+ byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,

256− byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,

219+ byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,

257− byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]

220+ byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]

258

221

259-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't

222-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't

260-- exactly sixteen bytes long

223-- exactly sixteen bytes long

@@ -275,10 +238,10 @@ null = (== nil)

275 -- null (UUID 0 0 0 0) = True

238 -- null (UUID 0 0 0 0) = True

276 -- null _ = False

239 -- null _ = False

277

240

278−-- |The 'nil' UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.

241+-- |The nil UUID, as defined in RFC 4122.

279−-- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@.

242+-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.

280nil :: UUID

243nil :: UUID

281−nil = UUID 0 0

244+nil = UUID 0 0 0 0

282

245

283-- |Extract a UUID from a 'ByteString' in network byte order.

246-- |Extract a UUID from a 'ByteString' in network byte order.

284-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.

247-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.

@@ -286,8 +249,6 @@ fromByteString :: BL.ByteString -> Maybe UUID

286fromByteString = fromList . BL.unpack

249fromByteString = fromList . BL.unpack

287

250

288-- |Encode a UUID into a 'ByteString' in network order.

251-- |Encode a UUID into a 'ByteString' in network order.

289−--

290−-- This uses the same encoding as the 'Binary' instance.

291toByteString :: UUID -> BL.ByteString

252toByteString :: UUID -> BL.ByteString

292toByteString = BL.pack . toList

253toByteString = BL.pack . toList

293

254

@@ -295,8 +256,9 @@ toByteString = BL.pack . toList

295-- The hyphens may not be omitted.

256-- The hyphens may not be omitted.

296-- Example:

257-- Example:

297--

258--

259+-- @

298−-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"

260+-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"

299−-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c

261+-- @

300--

262--

301-- Hex digits may be upper or lower-case.

263-- Hex digits may be upper or lower-case.

302fromString :: String -> Maybe UUID

264fromString :: String -> Maybe UUID

@@ -311,7 +273,7 @@ fromString' s0 = do

311 (w2, s3) <- hexWord s2

273 (w2, s3) <- hexWord s2

312 (w3, s4) <- hexWord s3

274 (w3, s4) <- hexWord s3

313 if s4 /= "" then Nothing

275 if s4 /= "" then Nothing

314− else Just $ fromWords w0 w1 w2 w3

276+ else Just $ UUID w0 w1 w2 w3

315 where hexWord :: String -> Maybe (Word32, String)

277 where hexWord :: String -> Maybe (Word32, String)

316 hexWord s = Just (0, s) >>= hexByte >>= hexByte

278 hexWord s = Just (0, s) >>= hexByte >>= hexByte

317 >>= hexByte >>= hexByte

279 >>= hexByte >>= hexByte

@@ -328,39 +290,21 @@ fromString' s0 = do

328-- | Convert a UUID into a hypenated string using lower-case letters.

290-- | Convert a UUID into a hypenated string using lower-case letters.

329-- Example:

291-- Example:

330--

292--

293+-- @

331−-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"

294+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"

332−-- Just "550e8400-e29b-41d4-a716-446655440000"

295+-- @

333−--

334−--

335toString :: UUID -> String

296toString :: UUID -> String

336−toString uuid = hexw0 w0 $ hexw1 w1 ""

297+toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""

337− where hexw0 :: Word64 -> String -> String

298+ where hexw :: Word32 -> String -> String

338− hexw0 w s = hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48

339− : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32

340− : '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16

299+ hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16

341− : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0

300+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s

342− : s

343−

344− hexw1 :: Word64 -> String -> String

345− hexw1 w s = '-' : hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48

346− : '-' : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32

347− : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16

348− : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0

349− : s

350−

351− hexn :: Word64 -> Int -> Char

352− hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)

353

301

354− (w0,w1) = toWords64 uuid

302+ hexw' :: Word32 -> String -> String

355−

303+ hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16

356−-- | If the passed in `Text` can be parsed as an ASCII representation of

304+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s

357−-- a `UUID`, it will be. The hyphens may not be omitted.

358−fromText :: Text -> Maybe UUID

359−fromText = fromASCIIBytes . T.encodeUtf8

360

305

361−-- | Convert a UUID into a hyphentated string using lower-case letters.

306+ hexn :: Word32 -> Int -> Char

362−toText :: UUID -> Text

307+ hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)

363−toText = T.decodeLatin1 . toASCIIBytes

364

308

365-- | Convert a UUID into a hyphentated string using lower-case letters, packed

309-- | Convert a UUID into a hyphentated string using lower-case letters, packed

366-- as ASCII bytes into `B.ByteString`.

310-- as ASCII bytes into `B.ByteString`.

@@ -455,30 +399,49 @@ fromASCIIBytes bs = do

455-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.

399-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.

456toLazyASCIIBytes :: UUID -> BL.ByteString

400toLazyASCIIBytes :: UUID -> BL.ByteString

457toLazyASCIIBytes =

401toLazyASCIIBytes =

402+#if MIN_VERSION_bytestring(0,10,0)

458 BL.fromStrict

403 BL.fromStrict

404+#else

405+ BL.fromChunks . return

406+#endif

459 . toASCIIBytes

407 . toASCIIBytes

460

408

461-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.

409-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.

462fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID

410fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID

463fromLazyASCIIBytes bs =

411fromLazyASCIIBytes bs =

464− if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing

412+ if BL.length bs == 36 then fromASCIIBytes (

413+#if MIN_VERSION_bytestring(0,10,0)

414+ BL.toStrict bs

415+#else

416+ B.concat $ BL.toChunks bs

417+#endif

418+ ) else Nothing

465

419

466--

420--

467-- Class Instances

421-- Class Instances

468--

422--

469

423

470−-- | This 'Random' instance produces __insecure__ version 4 UUIDs as

471−-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.

472instance Random UUID where

424instance Random UUID where

473− random = uniform

425+ random g = (fromGenNext w0 w1 w2 w3 w4, g4)

426+ where (w0, g0) = next g

427+ (w1, g1) = next g0

428+ (w2, g2) = next g1

429+ (w3, g3) = next g2

430+ (w4, g4) = next g3

474 randomR _ = random -- range is ignored

431 randomR _ = random -- range is ignored

475

432

476−-- @since 1.0.4

433+-- |Build a UUID from the results of five calls to next on a StdGen.

477−instance Uniform UUID where

434+-- While next on StdGet returns an Int, it doesn't provide 32 bits of

478− uniformM gen = do

435+-- randomness. This code relies on at last 28 bits of randomness in the

479− w0 <- uniformWord64 gen

436+-- and optimizes its use so as to make only five random values, not six.

480− w1 <- uniformWord64 gen

437+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID

438+fromGenNext w0 w1 w2 w3 w4 =

481− pure $ buildFromBytes 4 /-/ w0 /-/ w1

439+ buildFromBytes 4 /-/ (ThreeByte w0)

440+ /-/ (ThreeByte w1)

441+ /-/ w2 -- use all 4 bytes because we know the version

442+ -- field will "cover" the upper, non-random bits

443+ /-/ (ThreeByte w3)

444+ /-/ (ThreeByte w4)

482

445

483-- |A ByteSource to extract only three bytes from an Int, since next on StdGet

446-- |A ByteSource to extract only three bytes from an Int, since next on StdGet

484-- only returns 31 bits of randomness.

447-- only returns 31 bits of randomness.

@@ -486,29 +449,24 @@ type instance ByteSink ThreeByte g = Takes3Bytes g

486newtype ThreeByte = ThreeByte Int

449newtype ThreeByte = ThreeByte Int

487instance ByteSource ThreeByte where

450instance ByteSource ThreeByte where

488 f /-/ (ThreeByte w) = f b1 b2 b3

451 f /-/ (ThreeByte w) = f b1 b2 b3

489− where b1 = fromIntegral (w `unsafeShiftR` 16)

452+ where b1 = fromIntegral (w `shiftR` 16)

490− b2 = fromIntegral (w `unsafeShiftR` 8)

453+ b2 = fromIntegral (w `shiftR` 8)

491 b3 = fromIntegral w

454 b3 = fromIntegral w

492

455

493instance NFData UUID where

456instance NFData UUID where

494− rnf = flip seq ()

457+ rnf = rnf . toWords

495

458

496instance Hashable UUID where

459instance Hashable UUID where

497− hash (toWords -> (w0,w1,w2,w3)) =

460+ hash (UUID w0 w1 w2 w3) =

498 hash w0 `hashWithSalt` w1

461 hash w0 `hashWithSalt` w1

499 `hashWithSalt` w2

462 `hashWithSalt` w2

500 `hashWithSalt` w3

463 `hashWithSalt` w3

501− hashWithSalt s (toWords -> (w0,w1,w2,w3)) =

464+ hashWithSalt s (UUID w0 w1 w2 w3) =

502 s `hashWithSalt` w0

465 s `hashWithSalt` w0

503 `hashWithSalt` w1

466 `hashWithSalt` w1

504 `hashWithSalt` w2

467 `hashWithSalt` w2

505 `hashWithSalt` w3

468 `hashWithSalt` w3

506

469

507−-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.

508−--

509−-- >>> show nil

510−-- "00000000-0000-0000-0000-000000000000"

511−--

512instance Show UUID where

470instance Show UUID where

513 show = toString

471 show = toString

514

472

@@ -519,7 +477,7 @@ instance Read UUID where

519 Nothing -> []

477 Nothing -> []

520 Just u -> [(u,drop 36 noSpaces)]

478 Just u -> [(u,drop 36 noSpaces)]

521

479

522−-- | This 'Storable' instance uses the memory layout as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>, but in contrast to the 'Binary' instance, __the fields are stored in host byte order__.

480+

523instance Storable UUID where

481instance Storable UUID where

524 sizeOf _ = 16

482 sizeOf _ = 16

525 alignment _ = 4

483 alignment _ = 4

@@ -556,10 +514,10 @@ instance Storable UUID where

556 pokeByteOff p (off+14) x9

514 pokeByteOff p (off+14) x9

557 pokeByteOff p (off+15) x10

515 pokeByteOff p (off+15) x10

558

516

559−-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.

560instance Binary UUID where

517instance Binary UUID where

561− put (UUID w0 w1) = putWord64be w0 >> putWord64be w1

518+ put (UUID w0 w1 w2 w3) =

562− get = liftM2 UUID getWord64be getWord64be

519+ putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3

520+ get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be

563

521

564

522

565-- My goal with this instance was to make it work just enough to do what

523-- My goal with this instance was to make it work just enough to do what

@@ -570,6 +528,9 @@ instance Data UUID where

570 dataTypeOf _ = uuidType

528 dataTypeOf _ = uuidType

571

529

572uuidType :: DataType

530uuidType :: DataType

573−uuidType = mkNoRepType "Data.UUID.Types.UUID"

531+uuidType = mkNoRepType "Data.UUID.UUID"

574

532

575−deriving instance Lift UUID

533+#if !(MIN_VERSION_base(4,2,0))

534+mkNoRepType :: String -> DataType

535+mkNoRepType = mkNorepType

536+#endif

uuid/src/Data/UUID/Named.hs → Data/UUID/Named.hsrenamed+1−1

@@ -26,7 +26,7 @@ module Data.UUID.Named

26 ,namespaceX500

27 ) where

28

29−import Data.UUID.Types.Internal

29+import Data.UUID.Internal

30

31import Control.Applicative ((<*>),(<$>))

32import Data.Binary.Get (runGet, getWord32be)

uuid/src/Data/UUID/Util.hs → Data/UUID/Util.hsrenamed+12−1

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

3 UnpackedUUID(..)

4 , unpack, pack

5 , version

6+ , extractMac

6 , extractTime

7 , extractTime

7 , setTime

8 , setTime

8 ) where

9 ) where

@@ -11,7 +12,8 @@ import Prelude hiding (null)

11import Data.Word

12import Data.Word

12import Data.Word.Util

13import Data.Word.Util

13import Data.Bits

14import Data.Bits

14−import Data.UUID.Types.Internal

15+import Data.UUID.Internal

16+import Network.Info

15import Data.Int (Int64)

17import Data.Int (Int64)

16

18

17version :: UUID -> Int

19version :: UUID -> Int

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

40

42

41timeAndVersionToTime :: Word16 -> Word16

43timeAndVersionToTime :: Word16 -> Word16

42timeAndVersionToTime tv = tv .&. 0x0FFF

44timeAndVersionToTime 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

Data/UUID/V1.hsnew file+135

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

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 psuedo-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.Builder

43+import Data.UUID.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 sepcified 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/src/Data/UUID/V3.hs → Data/UUID/V3.hsrenamed+2−2

@@ -8,7 +8,7 @@ Maintainer : aslatter@gmail.com

8Stability : experimental

9Portability : portable

10

11−NOTE\: This module uses MD5 hashing. Unless you know

11+NOTE: This module uses MD5 hashing. Unless you know

12you need to use this module, you should probably be

13using "Data.UUID.V5", which offers the same sort of

14functionality as this module except implemented with

@@ -33,7 +33,7 @@ module Data.UUID.V3

33

34import Data.Word

35

36−import Data.UUID.Types.Internal

36+import Data.UUID.Internal

37import qualified Data.UUID.Named as Shared

38import qualified Crypto.Hash.MD5 as MD5

39

Data/UUID/V4.hsnew file+28

@@ -0,0 +1,28 @@

1+{- |

2+ Module : Data.UUID.V4

4+

5+ License : BSD-style

6+

7+ Maintainer : aslatter@gmail.com

8+ Stability : experimental

9+ Portability : portable

10+

11+ This module implements Version 4 UUIDs as specified

12+ in RFC 4122.

13+

14+ These UUIDs are generated from a psuedo-random generator.

15+ We use the System.Random 'R.StdGen' as our random source.

16+

17+ All of the logic is encapsulated in the 'R.Random' instance

18+ for the UUID type, so you are also free to use the random generator

19+ of your choice.

20+-}

21+module Data.UUID.V4 (nextRandom) where

22+

23+import Data.UUID

24+import qualified System.Random as R

25+

26+-- | Generate a random UUID. Introduced in version 1.2.6.

27+nextRandom :: IO UUID

28+nextRandom = R.randomIO

uuid/src/Data/UUID/V5.hs → Data/UUID/V5.hsrenamed+1−1

@@ -28,7 +28,7 @@ module Data.UUID.V5

28

29import Data.Word

30

31−import Data.UUID.Types.Internal

31+import Data.UUID.Internal

32import qualified Data.UUID.Named as Shared

33import qualified Crypto.Hash.SHA1 as SHA1

34

uuid/src/Data/Word/Util.hs → Data/Word/Util.hsrenamed

The content is the same.

uuid/Demo.hs → Demo.hsrenamed

The content is the same.

uuid-bench/LICENSE → LICENSErenamed

The content is the same.

Policy.mddeleted−11

@@ -1,11 +0,0 @@

1−# Versioning

2−

3−Because many consumers of the `UUID` type receive the type

4−through the `uuid` package and not the `uuid-types` package

5−we need to be careful about removing instances from the `uuid`

6−type.

7−

8−If the `uuid-types` package has a major-version bump because of

9−the removal of a class instance then we must also bump the major

10−version of the `uuid` package when we update the package

11−description to pull in the new version of `uuid-types`.

README.md+1−9

@@ -1,12 +1,4 @@

1−# uuid [![Build Status](https://travis-ci.org/hvr/uuid.svg?branch=master)](https://travis-ci.org/hvr/uuid)

1+# uuid [![Build Status](https://travis-ci.org/aslatter/uuid.svg?branch=master)](https://travis-ci.org/aslatter/uuid)

2

3This library is useful for creating, comparing, parsing and printing Universally

4Unique Identifiers. See http://en.wikipedia.org/wiki/UUID for the general idea.

5−

6−We offer two different packages: `uuid` and `uuid-types`

7−

8−The `uuid` package aims to be a fully-featured library for working with UUIDs.

9−

10−However if you're developing a library and only want the `UUID` type to show up

11−in your APIs you may want to use the `uuid-types` library to minimize the number

12−of dependencies needed by users of your library.

uuid-types/Setup.hs → Setup.hsrenamed

The content is the same.

cabal.bench.projectdeleted−4

@@ -1,4 +0,0 @@

1−-- separate package for benchmarks

2−-- this way we can build criterion

3−packages: uuid-bench

4−benchmarks: True

cabal.haskell-cideleted−7

@@ -1,7 +0,0 @@

1−branches: master

2−-- jobs-selection: any

3−head-hackage: False

4−

5−constraint-set random-1.2

6− ghc: >=7.10

7− constraints: random==1.2.*

cabal.projectdeleted−15

@@ -1,15 +0,0 @@

1−-- see http://cabal.readthedocs.io/en/latest/nix-local-build.html

2−-- for more details

3−

4−packages: uuid-types/

5−packages: uuid/

6−

7−package uuid-types

8− tests: True

9− -- profiling: True

10− -- profiling-detail: toplevel-functions

11−

12−package uuid

13− tests: True

14− -- profiling: True

15− -- profiling-detail: toplevel-functions

gen-ci.shdeleted−5

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

1−#!/bin/sh

2−

3−# haskell-ci doesn't know how to regenerate multiple GHA workflows

4−haskell-ci github cabal.project

5−haskell-ci github --project cabal.bench.project -o .github/workflows/haskell-ci-bench.yml --github-action-name Benchmarks

tests/BenchByteString.hsnew file+82

@@ -0,0 +1,82 @@

1+import Control.Applicative ((<*>))

2+import Data.Functor ((<$>))

3+

4+import Data.ByteString (ByteString)

5+import qualified Data.ByteString.Char8 as BC8

6+import System.Random

7+import Test.QuickCheck

8+

9+import Criterion

10+import Criterion.Main

11+

12+import Data.UUID

13+

14+instance Arbitrary UUID where

15+ arbitrary =

16+ fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

17+

18+-- Testing what we do in the codebase

19+fromASCIIBytes_naive :: ByteString -> Maybe UUID

20+fromASCIIBytes_naive = fromString . BC8.unpack

21+

22+toASCIIBytes_naive :: UUID -> ByteString

23+toASCIIBytes_naive = BC8.pack . toString

24+

25+randomUUIDs :: IO [UUID]

26+randomUUIDs = sample' arbitrary

27+

28+randomCorrect :: IO [String]

29+randomCorrect = map toString <$> randomUUIDs

30+

31+randomSlightlyWrong :: IO [String]

32+randomSlightlyWrong = mapM screw =<< randomCorrect

33+ where

34+ screw s = do

35+ ix <- randomRIO (0, length s - 1)

36+ return (take ix s ++ "x" ++ drop (ix + 1) s)

37+

38+randomVeryWrong :: IO [String]

39+randomVeryWrong = sample' arbitrary

40+

41+main :: IO ()

42+main = do

43+ uuids <- randomUUIDs

44+ correct <- randomCorrect

45+ let correctBytes = map BC8.pack correct

46+ slightlyWrong <- randomSlightlyWrong

47+ let slightlyWrongBytes = map BC8.pack slightlyWrong

48+ veryWrong <- randomVeryWrong

49+ let veryWrongBytes = map BC8.pack veryWrong

50+

51+ defaultMain

52+ [ bgroup "decoding"

53+ [ bcompare

54+ [ bgroup "correct"

55+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) correctBytes)

56+ , bench "fromString" (nf (map fromString) correct)

57+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) correctBytes)

58+ ]

59+ ]

60+ , bcompare

61+ [ bgroup "slightly wrong"

62+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) slightlyWrongBytes)

63+ , bench "fromString" (nf (map fromString) slightlyWrong)

64+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) slightlyWrongBytes)

65+ ]

66+ ]

67+ , bcompare

68+ [ bgroup "very wrong"

69+ [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) veryWrongBytes)

70+ , bench "fromString" (nf (map fromString) veryWrong)

71+ , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) veryWrongBytes)

72+ ]

73+ ]

74+ ]

75+ , bcompare

76+ [ bgroup "encoding"

77+ [ bench "toASCIIBytes" (nf (map toASCIIBytes) uuids)

78+ , bench "toString" (nf (map toString) uuids)

79+ , bench "toASCIIBytes_naive" (nf (map toASCIIBytes_naive) uuids)

80+ ]

81+ ]

82+ ]

uuid-bench/bench/uuid-types-benchmark.hs → tests/BenchUUID.hsrenamed+61−55

@@ -1,22 +1,26 @@

1{-# LANGUAGE CPP #-}

2

3#if !(MIN_VERSION_bytestring(0,10,0))

4−{-# OPTIONS_GHC -fno-warn-orphans #-}

5-- Needed for NFData instance

4-- Needed for NFData instance

6−import Control.DeepSeq

5+import Control.DeepSeq

7import qualified Data.ByteString.Lazy.Internal as BL

6import qualified Data.ByteString.Lazy.Internal as BL

8#endif

7#endif

9−import Criterion.Main

8+import Criterion.Main

9+import Data.Char (ord)

10+import Data.IORef

11+import Data.Maybe (fromJust)

12+import Data.Word

13+import qualified Data.Set as Set

10−import qualified Data.ByteString.Lazy as BL

14+import qualified Data.ByteString.Lazy as BL

11−import qualified Data.HashSet as HashSet

15+import qualified Data.UUID as U

12−import Data.Maybe (fromJust)

16+import qualified Data.UUID.V1 as U

13−import qualified Data.Set as Set

17+import qualified Data.UUID.V3 as U3

14−import qualified Data.UUID.Types as U

18+import qualified Data.UUID.V5 as U5

15−import Foreign (alloca, peek, poke)

19+import Foreign (alloca, peek, poke)

20+import System.Random

16−import System.Random

21+import System.Random.Mersenne.Pure64

17

22

18#if !(MIN_VERSION_bytestring(0,10,0))

23#if !(MIN_VERSION_bytestring(0,10,0))

19−-- orphan

20instance NFData BL.ByteString where

24instance NFData BL.ByteString where

21 rnf BL.Empty = ()

25 rnf BL.Empty = ()

22 rnf (BL.Chunk _ ts) = rnf ts

26 rnf (BL.Chunk _ ts) = rnf ts

@@ -24,56 +28,58 @@ instance NFData BL.ByteString where

24

28

25main :: IO ()

29main :: IO ()

26main = do

30main = do

27− u1 <- randomIO

31+ u1 <- randomIO

28− let s1 = U.toString u1

32+ let s1 = U.toString u1

29− b1 = U.toByteString u1

33+ b1 = U.toByteString u1

30− a1 = U.toASCIIBytes u1

34+ n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8]

31− t1 = U.toText u1

32− (w1a,w1b,w1c,w1d) = U.toWords u1

33− nil2 = fromJust $

35+ nil2 = fromJust $

34− U.fromString "00000000-0000-0000-0000-000000000000"

36+ U.fromString "00000000-0000-0000-0000-000000000000"

35− u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"

37+ u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"

36− u2b = fromJust $ U.fromByteString $

38+ u2b = fromJust $ U.fromByteString $

37− BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,

39+ BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,

38− 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]

40+ 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]

39− u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"

41+ u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"

40

42

41− -- setup for Storable benchmark

43+ -- setup for random generation

42− alloca $ \ uuidPtr -> do

44+ randomState <- newPureMT >>= newIORef

45+ let randomUUID = do

46+ state <- readIORef randomState

47+ let (uuid, state') = random state

48+ writeIORef randomState state'

49+ return uuid

43

50

51+ -- setup for Storable benchmark

44− poke uuidPtr u1

52+ alloca $ \ uuidPtr -> do

45

53

46− defaultMain [

54+ poke uuidPtr u1

47− bgroup "testing" [

48− bench "null non-nil" $ whnf U.null u1,

49− bench "null nil" $ whnf U.null U.nil,

50− bench "null nil2" $ whnf U.null nil2,

51− bench "eq same" $ whnf (==u2a) u2b,

52− bench "eq differ" $ whnf (==u2a) u3,

53− bench "compare same" $ whnf (compare u2a) u2b,

54− bench "compare differ" $ whnf (compare u2a) u3

55− ],

56− bgroup "conversion" [

57− bench "toString" $ nf U.toString u1,

58− bench "fromString" $ nf U.fromString s1,

59− bench "toByteString" $ nf U.toByteString u1,

60− bench "fromByteString" $ nf U.fromByteString b1,

61− bench "toASCIIBytes" $ nf U.toASCIIBytes u1,

62− bench "fromASCIIBytes" $ nf U.fromASCIIBytes a1,

63− bench "toWords" $ nf U.toWords u1,

64− bench "fromWords" $ nf (U.fromWords w1a w1b w1c) w1d,

65− bench "toText" $ nf U.toText u1,

66− bench "fromText" $ nf U.fromText t1

67− ],

68

55

69− bench "Set making" $ nf Set.fromList uuids,

56+ defaultMain [

57+ bgroup "testing" [

58+ bench "null non-nil" $ whnf U.null u1,

59+ bench "null nil" $ whnf U.null U.nil,

60+ bench "null nil2" $ whnf U.null nil2,

61+ bench "eq same" $ whnf (==u2a) u2b,

62+ bench "eq differ" $ whnf (==u2a) u3

63+ ],

64+ bgroup "conversion" [

65+ bench "toString" $ nf U.toString u1,

66+ bench "fromString" $ nf U.fromString s1,

67+ bench "toByteString" $ nf U.toByteString u1,

68+ bench "fromByteString" $ nf U.fromByteString b1

69+ ],

70+ bgroup "generation" [

71+ bench "V1" $ nfIO U.nextUUID,

72+ bench "V4" $ nfIO (randomUUID :: IO U.UUID),

73+ bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,

74+ bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1

75+ ],

70− bench "HashSet making" $ nf HashSet.fromList uuids,

76+ bench "set making" $ nf Set.fromList uuids,

71

77

72− bgroup "storable" [

78+ bgroup "storable" [

73− bench "peek" $ nfIO (peek uuidPtr),

79+ bench "peek" $ nfIO (peek uuidPtr),

74− bench "poke" $ whnfIO $ poke uuidPtr u1

80+ bench "poke" $ poke uuidPtr u1

81+ ]

75 ]

82 ]

76− ]

77

83

78-- 50 uuids, so tests can be repeatable

84-- 50 uuids, so tests can be repeatable

79uuids :: [U.UUID]

85uuids :: [U.UUID]

uuid-types/tests/TestUUID.hs → tests/TestUUID.hsrenamed+111−72

@@ -1,92 +1,101 @@

1{-# LANGUAGE ViewPatterns #-}

2−{-# LANGUAGE TemplateHaskell #-}

2+import Control.Monad (replicateM)

3−

3+import Data.Bits

4−{-# OPTIONS_GHC -fno-warn-orphans #-}

5−

6−import Data.Binary (encode)

7−import qualified Data.ByteString.Char8 as BC8

8−import qualified Data.ByteString.Lazy as BL

4+import qualified Data.ByteString.Lazy as BL

9import qualified Data.ByteString.Lazy.Char8 as BL8

5import qualified Data.ByteString.Lazy.Char8 as BL8

6+import qualified Data.ByteString.Char8 as BC8

10−import Data.Char (ord)

7+import Data.Char (ord)

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

8+import Data.Functor ((<$>))

12−import qualified Data.UUID.Types as U

9+import Data.List (nub, (\\))

10+import Data.Maybe

13−import Data.Word

11+import Data.Word

12+import qualified Data.UUID as U

13+import qualified Data.UUID.V1 as U

14+import qualified Data.UUID.V3 as U3

15+import qualified Data.UUID.V5 as U5

14−import Foreign (alloca, castPtr, peek, poke,

16+import Foreign (alloca, peek, poke)

15− sizeOf)

16−import GHC.ByteOrder (ByteOrder(..), targetByteOrder)

17−import System.IO.Unsafe (unsafePerformIO)

17+import System.IO.Unsafe (unsafePerformIO)

18−

18+import qualified Test.HUnit as H

19+import Test.HUnit hiding (Test)

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

20+import Test.QuickCheck hiding ((.&.))

21+import Test.Framework (defaultMain, Test)

22+import Test.Framework.Providers.HUnit (hUnitTestToTests)

23+import Test.Framework.Providers.QuickCheck2 (testProperty)

24+

25+

26+isValidVersion :: Int -> U.UUID -> Bool

27+isValidVersion v u = lenOK && variantOK && versionOK

28+ where bs = U.toByteString u

29+ lenOK = BL.length bs == 16

30+ variantOK = (BL.index bs 8) .&. 0xc0 == 0x80

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

20

32

21−import Test.Tasty (TestTree, defaultMain, testGroup)

22−import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))

23−import Test.Tasty.QuickCheck (testProperty)

24

33

25−

26−-- orphan

27instance Arbitrary U.UUID where

34instance Arbitrary U.UUID where

28 -- the UUID random instance ignores bounds

35 -- the UUID random instance ignores bounds

29 arbitrary = choose (U.nil, U.nil)

36 arbitrary = choose (U.nil, U.nil)

30

37

31−type Test = TestTree

32−

33−test_null :: Test

34−test_null =

35− testCase "nil is null" $

36− assertBool "" (U.null U.nil)

37

38

38−test_nil :: Test

39+test_null :: H.Test

39−test_nil = testGroup "nil" [

40+test_null = H.TestList [

40− testCase "nil string" $ U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",

41+ "nil is null" ~: assertBool "" (U.null U.nil),

41− testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)

42+ "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)

42 ]

43 ]

43

44

44−test_lift :: Test

45+test_nil :: H.Test

45−test_lift = testCase "TH.Lift" $ do

46+test_nil = H.TestList [

46− let uuid = U.fromWords64 123456789 987654321

47+ "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",

47− uuid @?= $( [| uuid |] )

48+ "nil bytes" ~: U.toByteString U.nil @?= BL.pack (replicate 16 0)

49+ ]

48

50

49−test_conv :: Test

51+test_conv :: H.Test

50−test_conv = testGroup "conversions" [

52+test_conv = H.TestList [

51− testCase "conv bytes to string" $

53+ "conv bytes to string" ~:

52 maybe "" (U.toString) (U.fromByteString b16) @?= s16,

54 maybe "" (U.toString) (U.fromByteString b16) @?= s16,

53− testCase "conv string to bytes" $

55+ "conv string to bytes" ~:

54 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16

56 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16

55 ]

57 ]

56 where b16 = BL.pack [1..16]

58 where b16 = BL.pack [1..16]

57 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"

59 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"

58

60

61+test_v1 :: [Maybe U.UUID] -> H.Test

62+test_v1 v1s = H.TestList [

63+ "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],

64+ "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,

65+ "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s

66+ ]

67+ where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> H.Test

68+ testUUID p u = maybe False p u ~? show u

69+

70+test_v3 :: H.Test

71+test_v3 = H.TestList [

72+ "V3 computation" ~:

73+ U3.generateNamed U3.namespaceDNS name @?= uV3

74+ ]

75+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]

76+ uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"

77+

78+test_v5 :: H.Test

79+test_v5 = H.TestList [

80+ "V5 computation" ~:

81+ U5.generateNamed U5.namespaceDNS name @?= uV5

82+ ]

83+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]

84+ uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"

85+

86+

59-- | Test fromByteString with a fixed-input.

87-- | Test fromByteString with a fixed-input.

60−test_fromByteString :: Test

88+test_fromByteString :: H.Test

61test_fromByteString =

89test_fromByteString =

62− testCase "UUID fromByteString" $

90+ "UUID fromByteString" ~:

63 Just inputUUID @=?

91 Just inputUUID @=?

64− U.fromByteString (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2")

92+ U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")

65

93

66-- | Test fromWords with a fixed-input

94-- | Test fromWords with a fixed-input

67−test_fromWords :: Test

95+test_fromWords :: H.Test

68test_fromWords =

96test_fromWords =

69− testCase "UUID fromWords" $

97+ "UUID fromWords" ~:

70− inputUUID @=? U.fromWords 0xa5ca8566 0xd9c54835 0x99c8e1f1 0x3e73b5e2

98+ inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594

71−

72−

73−test_Storeable :: Test

74−test_Storeable =

75− testCase "UUID Storeable(poke)" $

76− case targetByteOrder of

77− LittleEndian -> BC8.pack "\x66\x85\xca\xa5\xc5\xd9\x35\x48\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID

78− BigEndian -> BC8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID

79− where

80− pokeAsBS :: U.UUID -> BC8.ByteString

81− pokeAsBS uuid = unsafePerformIO $ do

82− alloca $ \ptr -> do

83− poke ptr uuid

84− BC8.packCStringLen (castPtr ptr, sizeOf uuid)

85−

86−test_Binary :: Test

87−test_Binary =

88− testCase "UUID Binary(encode)" $

89− (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2") @=? encode inputUUID

90

99

91inputUUID :: U.UUID

100inputUUID :: U.UUID

92inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"

101inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"

@@ -122,6 +131,31 @@ prop_randomNotNull = testProperty "Random not null" randomNotNull

122 where randomNotNull :: U.UUID -> Bool

131 where randomNotNull :: U.UUID -> Bool

123 randomNotNull = not. U.null

132 randomNotNull = not. U.null

124

133

134+prop_randomsValid :: Test

135+prop_randomsValid = testProperty "Random valid" randomsValid

136+ where randomsValid :: U.UUID -> Bool

137+ randomsValid = isValidVersion 4

138+

139+prop_v3NotNull :: Test

140+prop_v3NotNull = testProperty "V3 not null" v3NotNull

141+ where v3NotNull :: [Word8] -> Bool

142+ v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS

143+

144+prop_v3Valid :: Test

145+prop_v3Valid = testProperty "V3 valid" v3Valid

146+ where v3Valid :: [Word8] -> Bool

147+ v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS

148+

149+prop_v5NotNull :: Test

150+prop_v5NotNull = testProperty "V5 not null" v5NotNull

151+ where v5NotNull :: [Word8] -> Bool

152+ v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS

153+

154+prop_v5Valid :: Test

155+prop_v5Valid = testProperty "V5 valid" v5Valid

156+ where v5Valid :: [Word8] -> Bool

157+ v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS

158+

125prop_readShowRoundTrip :: Test

159prop_readShowRoundTrip :: Test

126prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop

160prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop

127 where -- we're using 'Maybe UUID' to add a bit of

161 where -- we're using 'Maybe UUID' to add a bit of

@@ -176,18 +210,18 @@ prop_storableRoundTrip =

176

210

177main :: IO ()

211main :: IO ()

178main = do

212main = do

213+ v1s <- replicateM 100 U.nextUUID

179 defaultMain $

214 defaultMain $

180− testGroup "tests" $

181 concat $

215 concat $

182− [ [

216+ [ hUnitTestToTests $ H.TestList [

183 test_null,

217 test_null,

184 test_nil,

218 test_nil,

185− test_lift,

186 test_conv,

219 test_conv,

220+ test_v1 v1s,

221+ test_v3,

222+ test_v5,

187 test_fromByteString,

223 test_fromByteString,

188− test_fromWords,

224+ test_fromWords

189− test_Storeable,

190− test_Binary

191 ]

225 ]

192 , [ prop_stringRoundTrip,

226 , [ prop_stringRoundTrip,

193 prop_readShowRoundTrip,

227 prop_readShowRoundTrip,

@@ -196,7 +230,12 @@ main = do

196 prop_stringLength,

230 prop_stringLength,

197 prop_byteStringLength,

231 prop_byteStringLength,

198 prop_randomsDiffer,

232 prop_randomsDiffer,

199− prop_randomNotNull

233+ prop_randomNotNull,

234+ prop_randomsValid,

235+ prop_v3NotNull,

236+ prop_v3Valid,

237+ prop_v5NotNull,

238+ prop_v5Valid

200 ]

239 ]

201 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1

240 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1

202 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2

241 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2

tests/summarize-bench-results.plnew file+14

@@ -0,0 +1,14 @@

1+#!/usr/bin/env perl

2+

3+

4+while(<>) {

5+ if (/^benchmarking (.*)$/) {

6+ $name = $1;

7+ }

8+ if (/^mean:\s*([\d.]*) (\w*),/) {

9+ $mean = 1 * $1;

10+ $units = $2;

11+

12+ printf "%-30s %10.2f %2s\n", $name, $mean, $units;

13+ }

14+}

uuid-bench/bench/uuid-benchmark.hsdeleted−33

@@ -1,33 +0,0 @@

1−import Criterion.Main

2−import Data.Char (ord)

3−import Data.IORef

4−import Data.Word

5−import qualified Data.UUID as U

6−import qualified Data.UUID.V4 as U

7−import qualified Data.UUID.V3 as U3

8−import qualified Data.UUID.V5 as U5

9−import System.Random

10−import System.Random.Mersenne.Pure64

11−

12−main :: IO ()

13−main = do

14− let n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8]

15−

16− -- setup for random generation

17− randomState <- newPureMT >>= newIORef

18− let randomUUID = do

19− state <- readIORef randomState

20− let (uuid, state') = random state

21− writeIORef randomState state'

22− return uuid

23−

24− -- benchmark UUID generation

25− defaultMain [

26− bgroup "generation" [

27− bench "V1" $ nfIO U.nextUUID,

28− bench "V4-stock" $ nfIO (U.nextRandom :: IO U.UUID),

29− bench "V4-mersenne" $ nfIO (randomUUID :: IO U.UUID),

30− bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,

31− bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1

32− ]

33− ]

uuid-bench/src-uuiddeleted−1

@@ -1 +0,0 @@

1−../uuid/src

uuid-bench/src-uuid-typesdeleted−1

@@ -1 +0,0 @@

1−../uuid-types/src

uuid-bench/uuid-bench.cabaldeleted−126

@@ -1,126 +0,0 @@

1−cabal-version: 1.12

2−name: uuid-bench

3−version: 0

4−copyright:

7−

8−author: Antoine Latter

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

10−license: BSD3

11−license-file: LICENSE

12−category: Data

13−build-type: Simple

14−

15−-- Benchmarking with older GHCs is not meaningful

16−tested-with:

17− GHC ==8.6.5

18− || ==8.8.4

19− || ==8.10.7

20− || ==9.0.2

21− || ==9.2.8

22− || ==9.4.8

23− || ==9.6.6

24− || ==9.8.2

25− || ==9.10.1

26−

27−synopsis: UUID benchmarks

28−description:

29− UUID benchmarks.

30− This package is combined uuid and uuid-types, renamed so we do not

31− cause benchmark tools to be build against local package.

32−

33−homepage: https://github.com/haskell-hvr/uuid

34−bug-reports: https://github.com/haskell-hvr/uuid/issues

35−

36−source-repository head

37− type: git

38− location: https://github.com/haskell-hvr/uuid.git

39− subdir: uuid-bench

40−

41−library

42− build-depends:

43− base >=4.12.0.0 && <5

44− , binary >=0.8.6.0 && <0.9

45− , bytestring >=0.10.8.2 && <0.13

46− , cryptohash-md5 >=0.11.100 && <0.12

47− , cryptohash-sha1 >=0.11.100 && <0.12

48− , deepseq >=1.4.4.0 && <1.6

49− , entropy >=0.3.7 && <0.5

50− , hashable >=1.4.4.0 && <1.6

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

52− , random >=1.2.1.2 && <1.3

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

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

55− , time >=1.4 && <1.13

56−

57− -- uuid modules

58− exposed-modules:

59− Data.UUID

60− Data.UUID.Util

61− Data.UUID.V3

62− Data.UUID.V4

63− Data.UUID.V5

64−

65− other-modules:

66− Data.UUID.Named

67− Data.Word.Util

68−

69− -- uuid-types modules

70− exposed-modules: Data.UUID.Types

71−

72− -- Exposed for companion projects; *NOT* part of the official API:

73− exposed-modules:

74− Data.UUID.Types.Internal

75− Data.UUID.Types.Internal.Builder

76−

77− default-language: Haskell2010

78− other-extensions:

79− DeriveDataTypeable

80− TypeFamilies

81−

82− ghc-options: -Wall

83− hs-source-dirs: src-uuid-types src-uuid

84−

85−benchmark uuid-types-benchmark

86− type: exitcode-stdio-1.0

87− main-is: uuid-types-benchmark.hs

88− hs-source-dirs: bench

89− default-language: Haskell2010

90− other-extensions: CPP

91− ghc-options: -Wall

92−

93− -- inherited constraints

94− build-depends:

95− base

96− , bytestring

97− , random

98− , uuid-bench

99−

100− -- deps w/o inherited constraints

101− build-depends:

102− containers >=0.5 && <0.8

103− , criterion >=1.5 && <1.7

104− , unordered-containers >=0.2.7 && <0.3

105−

106−benchmark uuid-benchmark

107− type: exitcode-stdio-1.0

108− main-is: uuid-benchmark.hs

109− hs-source-dirs: bench

110− default-language: Haskell2010

111− default-extensions:

112− CPP

113− DeriveDataTypeable

114−

115− ghc-options: -Wall -fno-warn-orphans

116−

117− -- inherited constraints

118− build-depends:

119− base

120− , random

121− , uuid-bench

122−

123− -- deps w/o inherited constraints

124− build-depends:

125− criterion >=1.5 && <1.7

126− , mersenne-random-pure64 >=0.2 && <0.3

uuid-types/ChangeLog.mddeleted−31

@@ -1,31 +0,0 @@

1−## 1.0.6 (2023-04-16)

2−

3−- Support GHC-8.6.5..GHC-9.10.1

4−

5−## 1.0.5 (2021-05-03)

6−

7−- Add (Template Haskell) `Lift UUID` instance

8−

9−## 1.0.4.0

10−

11−- Declare `Data.UUID.Types` module "`Trustworthy`" with respect to SafeHaskell.

12−- Use more compact heap object representation which saves 16 bytes on 64bit platforms.

13−- Add `toWords64`/`fromWords64` functions

14−- Drop support for GHC < 7.

15−- Add support for `random-1.2`, i.e. idiomatic `Random` and added `Uniform` instances.

16−

17−## 1.0.3

18−

19−- Bump package dependencies.

20−

21−## 1.0.2

22−

23−- Add `toText`/`fromText` functions.

24−

25−## 1.0.1

26−

27−- Update dependencies in tests and benchmarks.

28−

29−## 1.0.0

30−

31−- Initial split from "`uuid-1.3.8`" package.

uuid-types/LICENSEdeleted−28

@@ -1,28 +0,0 @@

2−

4−

5−Redistribution and use in source and binary forms, with or without

6−modification, are permitted provided that the following conditions are

7−met:

8−

9− * Redistributions of source code must retain the above copyright

10−notice, this list of conditions and the following disclaimer.

11− * Redistributions in binary form must reproduce the above copyright

12−notice, this list of conditions and the following disclaimer in the

13−documentation and/or other materials provided with the distribution.

14− * The names of the authors may not be used to endorse or promote

15−products derived from this software without specific prior written

16−permission.

17−

18−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

19−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

20−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

21−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

22−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

23−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED

24−TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR

25−PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF

26−LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING

27−NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS

28−SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

uuid-types/cabal.projectdeleted−1

@@ -1 +0,0 @@

1−packages: .

uuid-types/src/Data/UUID/Types.hsdeleted−47

@@ -1,47 +0,0 @@

1−{-# LANGUAGE Trustworthy #-}

2−

3−{- |

4−Module : Data.UUID.Types

7−

8−License : BSD-style

9−

10−Maintainer : hvr@gnu.org

11−Portability : portable

12−

13−This library is useful for comparing, parsing and

14−printing <http://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)>.

15−See <http://tools.ietf.org/html/rfc4122 RFC 4122> for the specification.

16−

17−-}

18−module Data.UUID.Types

19− ( -- * The 'UUID' Type

20− UUID

21− -- * Nil UUID

22− , nil

23− , null

24− -- * Textual Representation

25− , toString

26− , fromString

27− , toText

28− , fromText

29− , toASCIIBytes

30− , fromASCIIBytes

31− , toLazyASCIIBytes

32− , fromLazyASCIIBytes

33− -- * Binary Representation

34− , toByteString

35− , fromByteString

36− -- * Integer Representation

37− , toWords

38− , fromWords

39− , toWords64

40− , fromWords64

41− ) where

42−

43−import Data.UUID.Types.Internal

44−import Prelude ()

45−

46−-- Everything is really implemented in Data.UUID.Types.Internal, but I

47−-- don't want to export the constructors out of the package.

uuid-types/uuid-types.cabaldeleted−99

@@ -1,99 +0,0 @@

1−cabal-version: 1.12

2−name: uuid-types

3−version: 1.0.6

4−x-revision: 2

5−copyright:

8−

9−author: Antoine Latter

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

11−license: BSD3

12−license-file: LICENSE

13−category: Data

14−build-type: Simple

15−tested-with:

16− GHC ==8.6.5

17− || ==8.8.4

18− || ==8.10.7

19− || ==9.0.2

20− || ==9.2.8

21− || ==9.4.8

22− || ==9.6.6

23− || ==9.8.4

24− || ==9.10.1

25− || ==9.12.1

26−

27−synopsis: Type definitions for Universally Unique Identifiers

28−description:

29− This library contains type definitions for

30− <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)>

31− (as specified in

32− <http://tools.ietf.org/html/rfc4122 RFC 4122>)

33− and basic conversion functions.

34− .

35− See also the <https://hackage.haskell.org/package/uuid 'uuid' package>

36− providing a high-level API for managing the different UUID versions.

37−

38−homepage: https://github.com/haskell-hvr/uuid

39−bug-reports: https://github.com/haskell-hvr/uuid/issues

40−extra-source-files: ChangeLog.md

41−

42−source-repository head

43− type: git

44− location: https://github.com/haskell-hvr/uuid.git

45− subdir: uuid-types

46−

47−library

48− build-depends:

49− base >=4.12.0.0 && <5

50− , binary >=0.8.6.0 && <0.9

51− , bytestring >=0.10.8.2 && <0.13

52− , deepseq >=1.4.4.0 && <1.6

53− , hashable >=1.4.4.0 && <1.6

54− , random >=1.2.1.2 && <1.3

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

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

57−

58− exposed-modules: Data.UUID.Types

59−

60− -- Exposed for companion projects; *NOT* part of the official API:

61− exposed-modules:

62− Data.UUID.Types.Internal

63− Data.UUID.Types.Internal.Builder

64−

65− default-language: Haskell2010

66− other-extensions:

67− DeriveDataTypeable

68− TypeFamilies

69−

70− ghc-options: -Wall

71− hs-source-dirs: src

72−

73−test-suite testuuid

74− type: exitcode-stdio-1.0

75− main-is: TestUUID.hs

76− hs-source-dirs: tests

77− default-language: Haskell2010

78− other-extensions: ViewPatterns

79− ghc-options: -Wall

80− if impl(ghc >= 8.10)

81− ghc-options: -Wunused-packages

82−

83− -- inherited constraints

84− build-depends:

85− base

86− , binary

87− , bytestring

88− , template-haskell

89− , uuid-types

90−

91− -- deps w/o inherited constraints

92− build-depends:

93− QuickCheck >=2.14.2 && <2.16

94− , tasty >=1.4.0.1 && <1.6

95− , tasty-hunit >=0.10 && <0.11

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

97−

98− if !impl(ghc >=8.4)

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

uuid.cabalnew file+101

@@ -0,0 +1,101 @@

1+Name: uuid

2+Version: 1.3.8

4+Author: Antoine Latter

5+Maintainer: aslatter@gmail.com

6+License: BSD3

7+License-file: LICENSE

8+

9+Category: Data

10+Build-Type: Simple

11+Cabal-Version: >= 1.8

12+

13+Description:

14+ This library is useful for creating, comparing, parsing and

15+ printing Universally Unique Identifiers.

16+ See <http://en.wikipedia.org/wiki/UUID> for the general idea.

17+

18+Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers

19+

20+Homepage: https://github.com/aslatter/uuid

21+Bug-Reports: https://github.com/aslatter/uuid/issues

22+

23+Extra-Source-Files:

24+ CHANGES

25+ CONTRIBUTORS

26+

27+

28+Library

29+ Build-Depends: base >=3 && < 5,

30+ binary >= 0.4 && < 0.8,

31+ bytestring >= 0.9 && < 1.1,

32+ cryptohash >= 0.7 && < 0.12,

33+ deepseq >= 1.3 && < 1.5,

34+ hashable (>= 1.1.1.0 && < 1.2.0) || (>= 1.2.1 && < 1.3),

35+ network-info == 0.2.*,

36+ random >= 1.0.1 && < 1.2,

37+ time >= 1.1 && < 1.6

38+

39+ Exposed-Modules:

40+ Data.UUID

41+ Data.UUID.Util

42+ Data.UUID.V1

43+ Data.UUID.V3

44+ Data.UUID.V4

45+ Data.UUID.V5

46+

47+ Other-Modules:

48+ Data.UUID.Builder

49+ Data.UUID.Internal

50+ Data.UUID.Named

51+ Data.Word.Util

52+

53+ Extensions: DeriveDataTypeable

54+ Ghc-Options: -Wall

55+

56+source-repository head

57+ type: git

58+ location: https://github.com/aslatter/uuid.git

59+

60+Test-Suite testuuid

61+ Type: exitcode-stdio-1.0

62+ Main-is: TestUUID.hs

63+ Hs-source-dirs: tests

64+ Extensions: DeriveDataTypeable

65+ Ghc-Options: -Wall -fno-warn-orphans

66+ Build-Depends: base >= 3 && < 5,

67+ uuid,

68+ bytestring >= 0.9 && < 1.1,

69+ HUnit >=1.2 && < 1.3,

70+ QuickCheck >=2.4 && < 2.8,

71+ random >= 1.0.1 && < 1.2,

72+ test-framework == 0.8.*,

73+ test-framework-hunit == 0.3.*,

74+ test-framework-quickcheck2 == 0.3.*

75+

76+benchmark benchmark

77+ Type: exitcode-stdio-1.0

78+ Main-is: BenchUUID.hs

79+ Hs-source-dirs: tests

80+ Extensions: DeriveDataTypeable, CPP

81+ Ghc-Options: -Wall -fno-warn-orphans

82+ Build-depends: base == 4.*,

83+ uuid,

84+ bytestring >= 0.9 && < 1.1,

85+ containers >= 0.4 && < 0.6,

86+ criterion >= 0.4 && < 0.9,

87+ deepseq >= 1.1 && < 1.4,

88+ mersenne-random-pure64,

89+ random >= 1.0.1 && < 1.2

90+

91+benchmark benchbytestring

92+ Type: exitcode-stdio-1.0

93+ Hs-Source-Dirs: tests

94+ Main-Is: BenchByteString.hs

95+ Ghc-Options: -threaded -rtsopts -Wall -O2 -fno-warn-orphans

96+ Build-Depends: base >= 4 && < 5

97+ , uuid

98+ , bytestring >= 0.10

99+ , criterion >= 0.8

100+ , random >= 1.0

101+ , QuickCheck >= 2

uuid/CHANGES.mddeleted−186

@@ -1,186 +0,0 @@

1−1.3.16

2−

3−- Support GHC-8.6.5...9.10.1

4−

5−1.3.15

6−

7−- Add (Template Haskell) `Lift UUID` instance

8−

9−1.3.14

10−

11−- Use more compact heap object representation which saves 16 bytes on 64bit platforms.

12−- Add `toWords64`/`fromWords64` functions

13−

14−1.3.13

15−

16−- Optimize `V4.nextRandom` (~3x speed increase)

17−- Optimize UUID V3 & V5 generation (~2x speed increase)

18−- Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead

19− of `memory`/`cryptonite` for better performance and stability,

20− but GHCJS is now no longer supported.

21−- Update cabal-spec to version 1.10

22−

23−1.3.12

24−

25−- Update package dependencies

26−- Use `cryptonite` for crypto

27−- The function `V4.nextRandom` is now implemented with functions from

28− `Crypto.Random` in package `cryptonite`. This does slow-down random

29− UUID generation but provides for far greater randomness. The

30− `Random` instance for `UUID` can be used to re-gain the old

31− behavior.

32−

33−1.3.11

34−

35−- Add `toText`/`fromText`

36−

37−1.3.10

38−

39−- Update dependencies in tests and benchmarks.

40−

41−1.3.9

42−

43−- Split definition of UUID data type into separate Cabal package to

44− enable 3rd party libraries to avoid some of the larger dependencies.

45−

46−1.3.8

47−

48−- Allow building against newer `deepseq`.

49−

50−1.3.7

51−

52−- Allow building against newer `time`.

53−

54−1.3.6

55−

56−- Move to GitHub.

57−

58−1.3.5

59−

60−- Allow building against newer `random`.

61−

62−1.3.4

63−

64−- Allow building against newer `QuickCheck`.

65−

66−1.3.3

67−

68−- More complex version constraints on `hashable`, to avoid building against

69− versions less than 1.1.1.0 or equal to 1.2.0.*.

70−

71−1.3.2

72−

73−- Fix for building against `bytestring` 0.9.*

74−

75−1.3.1

76−

77−- Allow building against `hashable` 1.1.* in addition to 1.2.*

78−

79−1.3.0

80−

81−- New functions for parsing and printing UUIDs to and from ASCII BytesStrings

82−- New module `Data.UUID.Util`. This module includes the type `UnpackedUUID`,

83− whose fields correspond to the UUID fields described in RFC 4122.

84−- The `Storable` instance now stores a UUID in host byte-order instead of

85− big endian.

86−- There is now an instance for `Hashable UUID`.

87−

88−1.2.13

89−

90−Benchmark only changes:

91−

92−- Allow `criterion` 0.8.*

93−

94−1.2.12

95−

96−Test only changes:

97−

98−- Allow `QuickCheck` 2.6.*

99−

100−1.2.11

101−

102−- Allow `binary` 0.7.*

103−

104−1.2.10

105−

106−- Allow `cryptohash` version 0.9.*

107−- Cleanup tests

108−

109−1.2.9

110−

111−- Bumped dependency on `cryptohash`.

112−

113−1.2.8

114−

115−- Bumped various dependencies and cleaned up dependencies in general.

116−

117−1.2.7

118−

119−- Added stricter constraints on `random` package.

120−

121−1.2.6

122−

123−- Add module `V4` to direct attention to our Random instance

124−

125−- In module `V1` seed the generator with a random number

126− if the hardware MAC address could not be discovered.

127−

128−- Fix and cleanup various haddocks.

129−

130−- In module docs, warn about MD5 use in Data.UUID.V3 and

131− encourage the reader to use Data.UUID.V5 instead.

132−

133−1.2.5

134−

135−- Use `cryptohash` package for MD5 and SHA1 instead of `Crypto`

136−

137−1.2.4

138−

139−- Unpack Word32 values into UUID constructor.

140−

141−- Update test suite to QuickCheck 2

142−

143−- Bump other dependencies in tests/benchmarks

144−

145−1.2.3

146−

147−- The Read instance now drops leading spaces in the string to be parsed.

148−Thanks to Marc Ziegert for reporting this bug.

149−

150−- The tests have moved over to the new Cabal test running framework.

151−

152−1.2.2

153−

154−- Add functions fromWords/toWords

155−

156−The goal was to have a total function that can be used to construct

157−a UUID, primarily for use by uuid-th.

158−

159−1.2.1

160−

161−- Fix concurrency bug in Data.UUID.V1 (thanks to Neil Mitchell for reporting

162−and a test case)

163−

164−1.2.0

165− (Contributors: Antoine Latter & Mark Lentczner)

166−

167−- added functions toByteString and fromByteString

168−- added `nil` UUID

169−- added unit tests and benchmarks, built when configured -ftest

170−- major speed up of to/from functions (as well as in general)

171−- added version-3 generation (deterministic based on MD5)

172−- major changes to internal representation

173− - now uses four strict Word32 values

174− - internal ByteSource classes for easy construction (see Builder.hs)

175−- Storable instance now stores in memory as system libraries in C do:

176− 16 bytes derived from the network order of the fields, no matter what

177− the host native endianess is.

178−- fixed bugs in V1 time and clock stepping, and V1 generated values

179−- builds cleanly under GHC's -Wall

180−- added CHANGES file

181−

182−1.1.1

183−

184−- no longer exporting `null` from the prelude

185−- add `null` predicate on UUIDs

186−- documentation fix (thanks Mark Lentczner)

uuid/LICENSEdeleted−28