master..ca7eaad · typeable/uuid

git.iko.soy/typeable/uuid

on ca7eaad help sign in

.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+1−2

@@ -5,9 +5,8 @@ cabal.sandbox.config

5# Cabal stuff

6dist/

7cabal.config

8−dist-newstyle/

8+/dist-newstyle/

9/cabal.project.local

10−.ghc.environment.*

12# Emacs

11# Emacs

13*~

12*~

.travis.ymlnew file+77

@@ -0,0 +1,77 @@

1+# This Travis job script has been generated by a script via

2+#

3+# make_travis_yml_2.hs 'uuid-types.cabal'

4+#

5+# For more information, see https://github.com/hvr/multi-ghc-travis

6+#

7+language: c

8+sudo: false

9+dist: trusty

10+

11+git:

12+ submodules: false # whether to recursively clone submodules

13+

14+cache:

15+ directories:

16+ - $HOME/.cabal/packages

17+ - $HOME/.cabal/store

18+

19+before_cache:

20+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

21+ # remove files that are regenerated by 'cabal update'

22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

24+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

27+

28+matrix:

29+ include:

30+ # - compiler: "ghc-7.0.4"

31+ # # env: TEST=--disable-tests BENCH=--disable-benchmarks

32+ # addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.0.4], sources: [hvr-ghc]}}

33+ - compiler: "ghc-7.4.2"

34+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

35+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.4.2], sources: [hvr-ghc]}}

36+ - compiler: "ghc-7.6.3"

37+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.6.3], sources: [hvr-ghc]}}

39+ - compiler: "ghc-7.8.4"

40+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

41+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}

42+ - compiler: "ghc-7.10.3"

43+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

44+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}

45+ - compiler: "ghc-8.0.2"

46+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

47+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}

48+

49+before_install:

50+ - HC=${CC}

51+ - unset CC

52+ - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH

53+

54+install:

55+ - cabal --version

56+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

57+ - travis_retry cabal update -v

58+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

59+

60+ - cabal new-build -w ${HC} --dep -j2 all

61+

62+# Here starts the actual work to be performed for the package under test;

63+# any command which exits with a non-zero exit code causes the build to fail.

64+script:

65+ - cd uuid-types/

66+ - cabal sdist

67+ - cabal new-build -w ${HC} -j1

68+ - cabal new-test -w ${HC}

69+ - cd ..

70+

71+ - cd uuid/

72+ - cabal sdist

73+ - cabal new-build -w ${HC} -j1

74+ - cabal new-test -w ${HC}

75+ - cd ..

76+

77+# EOF

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.project+4−2

@@ -2,14 +2,16 @@

2-- for more details

4packages: uuid-types/

5−packages: uuid/

5+ uuid/

7package uuid-types

8 tests: True

9+ benchmarks: True

9 -- profiling: True

10 -- profiling: True

10 -- profiling-detail: toplevel-functions

11 -- profiling-detail: toplevel-functions

12package uuid

13package uuid

13 tests: True

14 tests: True

15+ benchmarks: True

14 -- profiling: True

16 -- profiling: True

15− -- profiling-detail: toplevel-functions

17+ -- 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

uuid-bench/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-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/CHANGESnew file+15

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

1+1.0.3

3+- Bump package dependencies

5+1.0.2

7+- Add toText/fromText

9+1.0.1

10+

11+- Update dependencies in tests and benchmarks.

12+

13+1.0.0

14+

15+- Initial split from "uuid-1.3.8"

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/Data/UUID/Types.hsnew file+39

@@ -0,0 +1,39 @@

1+{- |

2+Module : Data.UUID.Types

5+License : BSD-style

7+Maintainer : aslatter@gmail.com

8+Stability : experimental

9+Portability : portable

10+

11+

12+This library is useful for comparing, parsing and

13+printing Universally Unique Identifiers.

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

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

16+

17+-}

18+module Data.UUID.Types(UUID

19+ ,toString

20+ ,fromString

21+ ,toText

22+ ,fromText

23+ ,toASCIIBytes

24+ ,fromASCIIBytes

25+ ,toLazyASCIIBytes

26+ ,fromLazyASCIIBytes

27+ ,toByteString

28+ ,fromByteString

29+ ,toWords

30+ ,fromWords

31+ ,null

32+ ,nil

33+ ) where

34+

35+import Prelude () -- we need to hide Prelude.null

36+import Data.UUID.Types.Internal

37+

38+-- Everything is really implemented in Data.UUID.Types.Internal, but I

39+-- don't want to export the constructors out of the package.

uuid-types/src/Data/UUID/Types/Internal.hs → uuid-types/Data/UUID/Types/Internal.hsrenamed+173−198

@@ -1,86 +1,88 @@

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 #-}

2{-# OPTIONS_HADDOCK hide #-}

10-- |

4-- |

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

5-- Module : Data.UUID.Types.Internal

15--

8--

16-- License : BSD-style

9-- License : BSD-style

17--

10--

18−-- Maintainer : hvr@gnu.org

11+-- Maintainer : aslatter@gmail.com

12+-- Stability : experimental

19-- Portability : portable

13-- Portability : portable

21module Data.UUID.Types.Internal

15module Data.UUID.Types.Internal

22− ( UUID(..)

16+ (UUID(..)

23− , null

17+ ,null

24− , nil

18+ ,nil

25− , fromByteString

19+ ,fromByteString

26− , toByteString

20+ ,toByteString

27− , fromString

21+ ,fromString

28− , toString

22+ ,toString

29− , fromText

23+ ,fromText

30− , toText

24+ ,toText

31− , fromWords

25+ ,fromWords

32− , toWords

26+ ,toWords

33− , fromWords64

34− , toWords64

35− , toList

27+ ,toList

36− , buildFromBytes

28+ ,buildFromBytes

37− , buildFromWords

29+ ,buildFromWords

38− , fromASCIIBytes

30+ ,fromASCIIBytes

39− , toASCIIBytes

31+ ,toASCIIBytes

40− , fromLazyASCIIBytes

32+ ,fromLazyASCIIBytes

41− , toLazyASCIIBytes

33+ ,toLazyASCIIBytes

42− , UnpackedUUID(..)

34+ ,UnpackedUUID(..)

43− , pack

35+ ,pack

44− , unpack

36+ ,unpack

45 ) where

37 ) where

47−import Prelude hiding (null)

39+import Prelude hiding (null)

48−

40+

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

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

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

50−import Control.Monad (guard, liftM2)

43+import Control.Monad (liftM4, guard)

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

45+import Data.Char

51−import Data.Bits

46+import Data.Bits

52−import Data.Char

53−import Data.Data

54−import Data.Hashable

47+import Data.Hashable

55−import Data.List (elemIndices)

48+import Data.List (elemIndices)

56−import Foreign.Ptr (Ptr)

49+import Foreign.Ptr (Ptr)

57−

50+

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

52+import Data.Data

53+#else

54+import Data.Generics.Basics

55+#endif

56+

58−import Foreign.Storable

57+import Foreign.Storable

59−

58+

59+import Data.Binary

60−import Data.Binary

60+import Data.Binary.Put

61−import Data.Binary.Get

61+import Data.Binary.Get

62−import Data.Binary.Put

63−import qualified Data.ByteString as B

62+import qualified Data.ByteString as B

64−import qualified Data.ByteString.Internal as BI

63+import qualified Data.ByteString.Internal as BI

65−import qualified Data.ByteString.Lazy as BL

64+import qualified Data.ByteString.Lazy as BL

66−import qualified Data.ByteString.Unsafe as BU

65+import qualified Data.ByteString.Unsafe as BU

67−import Data.Text (Text)

66+import Data.Text (Text)

68−import qualified Data.Text.Encoding as T

67+import qualified Data.Text as T

69−

68+

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

69+import Data.UUID.Types.Internal.Builder

71−

70+

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

71+import System.Random

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

72+

74−

73+

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

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

76−

75+-- insecure 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

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

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

77+-- network order as 16 bytes.

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

78+data UUID

79+ = UUID

80+ {-# UNPACK #-} !Word32

81+ {-# UNPACK #-} !Word32

82+ {-# UNPACK #-} !Word32

83+ {-# UNPACK #-} !Word32

80− deriving (Eq, Ord)

84+ deriving (Eq, Ord, Typeable)

81{-

85{-

82− Prior to uuid-types-1.0.4:

83− !Word32 !Word32 !Word32 !Word32

84 Other representations that we tried are:

86 Other representations that we tried are:

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

87 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16

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

88 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8

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

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

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

93-}

95-}

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

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

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

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

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

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

98−--

100+-- 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)

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

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

102+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

103

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

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

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

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

117-- function for constructing 'UUID' values.

106-- function for constructing 'UUID' values.

118−--

107+-- 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

108fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

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

109+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

110

146data UnpackedUUID =

111data UnpackedUUID =

147 UnpackedUUID {

112 UnpackedUUID {

148− time_low :: Word32 -- 0-3

113+ time_low :: Word32 -- 0-3

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

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

150 , time_hi_and_version :: Word16 -- 6-7

115 , time_hi_and_version :: Word16 -- 6-7

151− , clock_seq_hi_res :: Word8 -- 8

116+ , clock_seq_hi_res :: Word8 -- 8

152− , clock_seq_low :: Word8 -- 9

117+ , clock_seq_low :: Word8 -- 9

153− , node_0 :: Word8

118+ , node_0 :: Word8

154− , node_1 :: Word8

119+ , node_1 :: Word8

155− , node_2 :: Word8

120+ , node_2 :: Word8

156− , node_3 :: Word8

121+ , node_3 :: Word8

157− , node_4 :: Word8

122+ , node_4 :: Word8

158− , node_5 :: Word8

123+ , node_5 :: Word8

159 }

124 }

160 deriving (Read, Show, Eq, Ord)

125 deriving (Read, Show, Eq, Ord)

161

126

162unpack :: UUID -> UnpackedUUID

127unpack :: UUID -> UnpackedUUID

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

128+unpack (UUID w0 w1 w2 w3) =

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

130+

164 where

131 where

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

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

166 UnpackedUUID {

133 UnpackedUUID {

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

195

162

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

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

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

164word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32

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

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

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

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

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

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

201− .|. (fromIntegral d )

168+ .|. (fromIntegral d )

202

169

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

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

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

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

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

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

206

173

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

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

208w8to16 :: Word8 -> Word8 -> Word16

175w8to16 :: Word8 -> Word8 -> Word16

209w8to16 w0s w1s =

176w8to16 w0s w1s =

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

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

211 where

178 where

212 w0 = fromIntegral w0s

179 w0 = fromIntegral w0s

213 w1 = fromIntegral w1s

180 w1 = fromIntegral w1s

214

181

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

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

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

218

182

219-- |Make a UUID from sixteen Word8 values

183-- |Make a UUID from sixteen Word8 values

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

184makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8

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

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

187 -> Word8 -> Word8 -> Word8 -> Word8

224 -> UUID

188 -> UUID

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

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

226− = fromWords w0 w1 w2 w3

190+ = UUID w0 w1 w2 w3

227 where w0 = word b0 b1 b2 b3

191 where w0 = word b0 b1 b2 b3

228 w1 = word b4 b5 b6 b7

192 w1 = word b4 b5 b6 b7

229 w2 = word b8 b9 ba bb

193 w2 = word b8 b9 ba bb

230 w3 = word bc bd be bf

194 w3 = word bc bd be bf

231

195

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

197+makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID

198+makeFromWords = UUID

199+

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

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

233buildFromBytes :: Word8

201buildFromBytes :: Word8

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

202 -> Word8 -> Word8 -> Word8 -> Word8

@@ -241,20 +209,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)

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

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

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

243

211

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

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

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

213buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID

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

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

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

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

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

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

249

217

250

218

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

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

252toList :: UUID -> [Word8]

220toList :: UUID -> [Word8]

253−toList (UUID w0 w1) =

221+toList (UUID w0 w1 w2 w3) =

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

222+ [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,

223+ 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,

224+ 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]

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

258

226

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

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

260-- exactly sixteen bytes long

228-- exactly sixteen bytes long

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

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

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

276 -- null _ = False

244 -- null _ = False

277

245

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

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

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

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

280nil :: UUID

248nil :: UUID

281−nil = UUID 0 0

249+nil = UUID 0 0 0 0

282

250

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

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

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

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

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

286fromByteString = fromList . BL.unpack

254fromByteString = fromList . BL.unpack

287

255

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

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

289−--

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

291toByteString :: UUID -> BL.ByteString

257toByteString :: UUID -> BL.ByteString

292toByteString = BL.pack . toList

258toByteString = BL.pack . toList

293

259

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

295-- The hyphens may not be omitted.

261-- The hyphens may not be omitted.

296-- Example:

262-- Example:

297--

263--

264+-- @

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

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

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

266+-- @

300--

267--

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

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

302fromString :: String -> Maybe UUID

269fromString :: String -> Maybe UUID

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

311 (w2, s3) <- hexWord s2

278 (w2, s3) <- hexWord s2

312 (w3, s4) <- hexWord s3

279 (w3, s4) <- hexWord s3

313 if s4 /= "" then Nothing

280 if s4 /= "" then Nothing

314− else Just $ fromWords w0 w1 w2 w3

281+ else Just $ UUID w0 w1 w2 w3

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

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

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

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

317 >>= hexByte >>= hexByte

284 >>= hexByte >>= hexByte

@@ -328,39 +295,30 @@ fromString' s0 = do

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

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

329-- Example:

296-- Example:

330--

297--

298+-- @

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

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

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

300+-- @

333−--

334−--

335toString :: UUID -> String

301toString :: UUID -> String

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

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

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

303+ 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

304+ 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

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

342− : s

306+

343−

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

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

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

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

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

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

349− : s

350−

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

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

353

310

354− (w0,w1) = toWords64 uuid

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

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

355

313

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

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

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

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

358fromText :: Text -> Maybe UUID

316fromText :: Text -> Maybe UUID

359−fromText = fromASCIIBytes . T.encodeUtf8

317+fromText = fromString . T.unpack

360

318

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

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

362toText :: UUID -> Text

320toText :: UUID -> Text

363−toText = T.decodeLatin1 . toASCIIBytes

321+toText = T.pack . toString

364

322

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

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

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

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

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

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

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

456toLazyASCIIBytes :: UUID -> BL.ByteString

414toLazyASCIIBytes :: UUID -> BL.ByteString

457toLazyASCIIBytes =

415toLazyASCIIBytes =

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

458 BL.fromStrict

417 BL.fromStrict

418+#else

419+ BL.fromChunks . return

420+#endif

459 . toASCIIBytes

421 . toASCIIBytes

460

422

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

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

462fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID

424fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID

463fromLazyASCIIBytes bs =

425fromLazyASCIIBytes bs =

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

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

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

428+ BL.toStrict bs

429+#else

430+ B.concat $ BL.toChunks bs

431+#endif

432+ ) else Nothing

465

433

466--

434--

467-- Class Instances

435-- Class Instances

468--

436--

469

437

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

438instance Random UUID where

473− random = uniform

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

440+ where (w0, g0) = next g

441+ (w1, g1) = next g0

442+ (w2, g2) = next g1

443+ (w3, g3) = next g2

444+ (w4, g4) = next g3

474 randomR _ = random -- range is ignored

445 randomR _ = random -- range is ignored

475

446

476−-- @since 1.0.4

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

477−instance Uniform UUID where

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

478− uniformM gen = do

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

479− w0 <- uniformWord64 gen

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

480− w1 <- uniformWord64 gen

451+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID

452+fromGenNext w0 w1 w2 w3 w4 =

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

453+ buildFromBytes 4 /-/ (ThreeByte w0)

454+ /-/ (ThreeByte w1)

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

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

457+ /-/ (ThreeByte w3)

458+ /-/ (ThreeByte w4)

482

459

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

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

484-- only returns 31 bits of randomness.

461-- only returns 31 bits of randomness.

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

486newtype ThreeByte = ThreeByte Int

463newtype ThreeByte = ThreeByte Int

487instance ByteSource ThreeByte where

464instance ByteSource ThreeByte where

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

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

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

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

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

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

491 b3 = fromIntegral w

468 b3 = fromIntegral w

492

469

493instance NFData UUID where

470instance NFData UUID where

494− rnf = flip seq ()

471+ rnf = rnf . toWords

495

472

496instance Hashable UUID where

473instance Hashable UUID where

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

474+ hash (UUID w0 w1 w2 w3) =

498 hash w0 `hashWithSalt` w1

475 hash w0 `hashWithSalt` w1

499 `hashWithSalt` w2

476 `hashWithSalt` w2

500 `hashWithSalt` w3

477 `hashWithSalt` w3

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

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

502 s `hashWithSalt` w0

479 s `hashWithSalt` w0

503 `hashWithSalt` w1

480 `hashWithSalt` w1

504 `hashWithSalt` w2

481 `hashWithSalt` w2

505 `hashWithSalt` w3

482 `hashWithSalt` w3

506

483

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

484instance Show UUID where

513 show = toString

485 show = toString

514

486

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

519 Nothing -> []

491 Nothing -> []

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

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

521

493

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__.

494+

523instance Storable UUID where

495instance Storable UUID where

524 sizeOf _ = 16

496 sizeOf _ = 16

525 alignment _ = 4

497 alignment _ = 4

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

556 pokeByteOff p (off+14) x9

528 pokeByteOff p (off+14) x9

557 pokeByteOff p (off+15) x10

529 pokeByteOff p (off+15) x10

558

530

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

531instance Binary UUID where

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

532+ put (UUID w0 w1 w2 w3) =

562− get = liftM2 UUID getWord64be getWord64be

533+ putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3

534+ get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be

563

535

564

536

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

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

@@ -572,4 +544,7 @@ instance Data UUID where

572uuidType :: DataType

544uuidType :: DataType

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

545uuidType = mkNoRepType "Data.UUID.Types.UUID"

574

546

575−deriving instance Lift UUID

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

548+mkNoRepType :: String -> DataType

549+mkNoRepType = mkNorepType

550+#endif

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

@@ -1,9 +1,7 @@

1{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE Unsafe #-}

3−

4{-# OPTIONS_HADDOCK hide #-}

2{-# OPTIONS_HADDOCK hide #-}

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

4+-- Module : Data.UUID.Types.Internal.Builder

8--

6--

9-- License : BSD-style

7-- License : BSD-style

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

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

47type Takes2Bytes g = Word8 -> Word8 -> g

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

48type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g

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

49type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g

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

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

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

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

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

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

57type instance ByteSink Word8 g = Takes1Byte g

54type instance ByteSink Word8 g = Takes1Byte g

58type instance ByteSink Word16 g = Takes2Bytes g

55type instance ByteSink Word16 g = Takes2Bytes g

59type instance ByteSink Word32 g = Takes4Bytes g

56type instance ByteSink Word32 g = Takes4Bytes g

60−type instance ByteSink Word64 g = Takes8Bytes g

61type instance ByteSink Int g = Takes4Bytes g

57type instance ByteSink Int g = Takes4Bytes g

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

85 b3 = fromIntegral (w `shiftR` 8)

81 b3 = fromIntegral (w `shiftR` 8)

86 b4 = fromIntegral w

82 b4 = fromIntegral w

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

84instance ByteSource Int where

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

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

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

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

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-bench/bench/uuid-types-benchmark.hs → uuid-types/tests/BenchUUID.hsrenamed+53−55

@@ -1,22 +1,20 @@

1{-# LANGUAGE CPP #-}

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.Maybe (fromJust)

10+import qualified Data.Set as Set

11+import qualified Data.HashSet as HashSet

10−import qualified Data.ByteString.Lazy as BL

12+import qualified Data.ByteString.Lazy as BL

11−import qualified Data.HashSet as HashSet

13+import qualified Data.UUID.Types as U

12−import Data.Maybe (fromJust)

13−import qualified Data.Set as Set

14−import qualified Data.UUID.Types as U

15−import Foreign (alloca, peek, poke)

14+import Foreign (alloca, peek, poke)

16−import System.Random

15+import System.Random

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

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

19−-- orphan

20instance NFData BL.ByteString where

18instance NFData BL.ByteString where

21 rnf BL.Empty = ()

19 rnf BL.Empty = ()

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

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

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

25main :: IO ()

23main :: IO ()

26main = do

24main = do

27− u1 <- randomIO

25+ u1 <- randomIO

28− let s1 = U.toString u1

26+ let s1 = U.toString u1

29− b1 = U.toByteString u1

27+ b1 = U.toByteString u1

30− a1 = U.toASCIIBytes u1

28+ a1 = U.toASCIIBytes u1

31− t1 = U.toText u1

29+ t1 = U.toText u1

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

30+ (w1a,w1b,w1c,w1d) = U.toWords u1

33− nil2 = fromJust $

31+ nil2 = fromJust $

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

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

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

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

36− u2b = fromJust $ U.fromByteString $

34+ u2b = fromJust $ U.fromByteString $

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

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

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

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

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

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

41− -- setup for Storable benchmark

39+ -- setup for Storable benchmark

42− alloca $ \ uuidPtr -> do

40+ alloca $ \ uuidPtr -> do

44− poke uuidPtr u1

42+ poke uuidPtr u1

46− defaultMain [

44+ defaultMain [

47− bgroup "testing" [

45+ bgroup "testing" [

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

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

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

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

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

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

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

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

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

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

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

51+ bench "compare same" $ whnf (compare u2a) u2b,

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

52+ bench "compare differ" $ whnf (compare u2a) u3

55− ],

53+ ],

56− bgroup "conversion" [

54+ bgroup "conversion" [

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

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

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

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

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

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

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

58+ bench "fromByteString" $ nf U.fromByteString b1,

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

59+ bench "toASCIIBytes" $ nf U.toASCIIBytes u1,

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

60+ bench "fromASCIIBytes" $ nf U.fromASCIIBytes a1,

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

61+ bench "toWords" $ nf U.toWords u1,

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

62+ bench "fromWords" $ nf (U.fromWords w1a w1b w1c) w1d,

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

63+ bench "toText" $ nf U.toText u1,

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

64+ bench "fromText" $ nf U.fromText t1

67− ],

65+ ],

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

67+ bench "Set making" $ nf Set.fromList uuids,

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

68+ bench "HashSet making" $ nf HashSet.fromList uuids,

72− bgroup "storable" [

70+ bgroup "storable" [

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

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

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

72+ bench "poke" $ whnfIO $ poke uuidPtr u1

73+ ]

75 ]

74 ]

76− ]

78-- 50 uuids, so tests can be repeatable

76-- 50 uuids, so tests can be repeatable

79uuids :: [U.UUID]

77uuids :: [U.UUID]

uuid-types/tests/TestUUID.hs+15−49

@@ -1,29 +1,22 @@

1{-# LANGUAGE ViewPatterns #-}

2−{-# LANGUAGE TemplateHaskell #-}

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

3+import qualified Data.ByteString.Lazy as BL

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

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

5+import qualified Data.ByteString.Char8 as BC8

10−import Data.Char (ord)

6+import Data.Char (ord)

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

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

8+import Data.Word

12−import qualified Data.UUID.Types as U

9+import qualified Data.UUID.Types as U

13−import Data.Word

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

10+import Foreign (alloca, peek, poke)

15− sizeOf)

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

17−import System.IO.Unsafe (unsafePerformIO)

11+import System.IO.Unsafe (unsafePerformIO)

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

13+import Test.QuickCheck ( Arbitrary(arbitrary), choose )

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

15+import Test.Tasty ( defaultMain, TestTree, testGroup )

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

16+import Test.Tasty.HUnit ( assertBool, (@?=), (@=?), testCase )

23−import Test.Tasty.QuickCheck (testProperty)

17+import Test.Tasty.QuickCheck ( testProperty )

26−-- orphan

27instance Arbitrary U.UUID where

20instance Arbitrary U.UUID where

28 -- the UUID random instance ignores bounds

21 -- the UUID random instance ignores bounds

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

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

@@ -41,11 +34,6 @@ test_nil = testGroup "nil" [

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

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

42 ]

35 ]

44−test_lift :: Test

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

46− let uuid = U.fromWords64 123456789 987654321

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

48−

49test_conv :: Test

37test_conv :: Test

50test_conv = testGroup "conversions" [

38test_conv = testGroup "conversions" [

51 testCase "conv bytes to string" $

39 testCase "conv bytes to string" $

@@ -61,32 +49,13 @@ test_fromByteString :: Test

61test_fromByteString =

49test_fromByteString =

62 testCase "UUID fromByteString" $

50 testCase "UUID fromByteString" $

63 Just inputUUID @=?

51 Just inputUUID @=?

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

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

66-- | Test fromWords with a fixed-input

54-- | Test fromWords with a fixed-input

67test_fromWords :: Test

55test_fromWords :: Test

68test_fromWords =

56test_fromWords =

69 testCase "UUID fromWords" $

57 testCase "UUID fromWords" $

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

58+ 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

91inputUUID :: U.UUID

60inputUUID :: U.UUID

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

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

@@ -182,12 +151,9 @@ main = do

182 [ [

151 [ [

183 test_null,

152 test_null,

184 test_nil,

153 test_nil,

185− test_lift,

186 test_conv,

154 test_conv,

187 test_fromByteString,

155 test_fromByteString,

188− test_fromWords,

156+ test_fromWords

189− test_Storeable,

190− test_Binary

191 ]

157 ]

192 , [ prop_stringRoundTrip,

158 , [ prop_stringRoundTrip,

193 prop_readShowRoundTrip,

159 prop_readShowRoundTrip,

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

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

1+#!/usr/bin/env perl

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-types/uuid-types.cabal+71−90

@@ -1,99 +1,80 @@

1−cabal-version: 1.12

2−name: uuid-types

1+Name: uuid-types

3−version: 1.0.6

2+Version: 1.0.3

4−x-revision: 2

5−copyright:

4+Author: Antoine Latter

5+Maintainer: hvr@gnu.org

6+License: BSD3

7+License-file: LICENSE

8+Category: Data

9+Build-Type: Simple

10+Cabal-Version: >= 1.8

11+Tested-With: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2

9−author: Antoine Latter

13+Synopsis: Type definitions for Universally Unique Identifiers

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

14+Description:

11−license: BSD3

15+ This library contains type definitions for Universally Unique Identifiers

12−license-file: LICENSE

16+ and basic conversion functions.

13−category: Data

17+ .

14−build-type: Simple

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

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

27−synopsis: Type definitions for Universally Unique Identifiers

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

28−description:

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

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.

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

23+Extra-Source-Files:

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

24+ CHANGES

40−extra-source-files: ChangeLog.md

42−source-repository head

26+Source-Repository head

43− type: git

27+ Type: git

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

28+ Location: https://github.com/hvr/uuid.git

45− subdir: uuid-types

29+ Subdir: uuid-types

47−library

31+Library

48− build-depends:

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

49− base >=4.12.0.0 && <5

50− , binary >=0.8.6.0 && <0.9

33+ binary >= 0.4 && < 0.9,

51− , bytestring >=0.10.8.2 && <0.13

34+ bytestring >= 0.9 && < 0.11,

52− , deepseq >=1.4.4.0 && <1.6

35+ deepseq >= 1.3 && < 1.5,

53− , hashable >=1.4.4.0 && <1.6

36+ hashable (>= 1.1.1.0 && < 1.2) || (>= 1.2.1 && < 1.3),

54− , random >=1.2.1.2 && <1.3

37+ random >= 1.0.1 && < 1.2,

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

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

38+ text >= 1 && < 1.3

40+ Exposed-Modules:

41+ Data.UUID.Types

42+ -- Exposed for companion projects; *NOT* part of the official API:

43+ Data.UUID.Types.Internal.Builder

58− exposed-modules: Data.UUID.Types

44+ Data.UUID.Types.Internal

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

46+ Extensions: DeriveDataTypeable

61− exposed-modules:

47+ Other-Extensions: TypeFamilies

62− Data.UUID.Types.Internal

48+ Ghc-Options: -Wall

63− Data.UUID.Types.Internal.Builder

65− default-language: Haskell2010

50+Test-Suite testuuid

66− other-extensions:

51+ Type: exitcode-stdio-1.0

52+ Main-is: TestUUID.hs

53+ Hs-source-dirs: tests

67− DeriveDataTypeable

54+ Extensions: DeriveDataTypeable

68− TypeFamilies

55+ Other-Extensions: ViewPatterns

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

57+ Build-Depends: uuid-types

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

59+ bytestring >= 0.9 && < 0.11,

60+ HUnit >= 1.2 && < 1.4,

61+ QuickCheck >= 2.4 && < 2.10,

62+ tasty >= 0.10 && < 0.12,

63+ tasty-hunit == 0.9.*,

64+ tasty-quickcheck == 0.8.*

70− ghc-options: -Wall

66+benchmark benchmark

71− hs-source-dirs: src

72−

73−test-suite testuuid

74− type: exitcode-stdio-1.0

67+ Type: exitcode-stdio-1.0

75− main-is: TestUUID.hs

68+ Main-is: BenchUUID.hs

76− hs-source-dirs: tests

69+ Hs-source-dirs: tests

77− default-language: Haskell2010

70+ Extensions: DeriveDataTypeable

78− other-extensions: ViewPatterns

71+ Other-Extensions: CPP

79− ghc-options: -Wall

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

80− if impl(ghc >= 8.10)

73+ Build-Depends: uuid-types

81− ghc-options: -Wunused-packages

82−

83− -- inherited constraints

84− build-depends:

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

85− base

86− , binary

87− , bytestring

75+ bytestring >= 0.9 && < 0.11,

88− , template-haskell

76+ containers >= 0.4 && < 0.6,

89− , uuid-types

77+ criterion >= 0.4 && < 1.2,

90−

78+ deepseq >= 1.1 && < 1.5,

91− -- deps w/o inherited constraints

79+ random >= 1.0.1 && < 1.2,

92− build-depends:

80+ unordered-containers >= 0.2.7 && < 0.3

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/CHANGES.md+1−15

@@ -1,23 +1,9 @@

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−

141.3.13

11.3.13

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

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

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

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

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

5- Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead

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

6+ of `memory`/`cryptonite` for better performance and stability.

20− but GHCJS is now no longer supported.

21- Update cabal-spec to version 1.10

7- Update cabal-spec to version 1.10

231.3.12

91.3.12

uuid/src/Data/UUID.hs → uuid/Data/UUID.hsrenamed+3−2

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

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

19generation of UUIDs.

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

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

23+

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

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

22"Data.UUID.V5".

25"Data.UUID.V5".

23-}

26-}

@@ -34,8 +37,6 @@ module Data.UUID(UUID

34 ,fromByteString

37 ,fromByteString

35 ,toWords

38 ,toWords

36 ,fromWords

39 ,fromWords

37− ,toWords64

38− ,fromWords64

39 ,null

40 ,null

40 ,nil

41 ,nil

41 ) where

42 ) where

uuid/src/Data/UUID/Named.hs → uuid/Data/UUID/Named.hsrenamed

The content is the same.

uuid/src/Data/UUID/Util.hs → uuid/Data/UUID/Util.hsrenamed+11

@@ -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

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

12import Data.Word.Util

13import Data.Word.Util

13import Data.Bits

14import Data.Bits

14import Data.UUID.Types.Internal

15import Data.UUID.Types.Internal

16+import Network.Info

15import Data.Int (Int64)

17import Data.Int (Int64)

17version :: UUID -> Int

19version :: UUID -> Int

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

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

uuid/Data/UUID/V1.hsnew file+135

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

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

2+{-# LANGUAGE TypeFamilies #-}

4+{- |

5+Module : Data.UUID.V1

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.Types.Internal.Builder

43+import Data.UUID.Types.Internal

44+

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

46+-- address and the current system time.

47+-- Is generated according to the Version 1 UUID 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 → uuid/Data/UUID/V3.hsrenamed+1−1

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

8Stability : experimental

9Portability : portable

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

uuid/src/Data/UUID/V4.hs → uuid/Data/UUID/V4.hsrenamed+8−6

@@ -11,9 +11,12 @@

11 This module implements Version 4 UUIDs as specified

12 in RFC 4122.

14− These UUIDs are generated from a pseudo-random generator.

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

15− We use the 'getEntropy' method from the <https://hackage.haskell.org/package/entropy entropy> package,

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

16− which should provide cryptographically secure random data.

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.

17-}

20-}

18module Data.UUID.V4 (nextRandom) where

21module Data.UUID.V4 (nextRandom) where

@@ -23,9 +26,8 @@ import Data.UUID.Types.Internal ( buildFromBytes )

23import System.Entropy ( getEntropy )

26import System.Entropy ( getEntropy )

24import Data.ByteString ( unpack )

27import Data.ByteString ( unpack )

26−-- | Generate a crytographically secure, random UUID.

29+-- | Generate a crytographically secure, random UUID. Introduced in version

27−--

28−-- @since 1.2.6

30+-- 1.2.6.

29nextRandom :: IO UUID

31nextRandom :: IO UUID

30nextRandom = do

32nextRandom = do

31 [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]

33 [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]

uuid/src/Data/UUID/V5.hs → uuid/Data/UUID/V5.hsrenamed

The content is the same.

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

The content is the same.

uuid-bench/bench/uuid-benchmark.hs → uuid/tests/BenchUUID.hsrenamed+1

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

3import Data.IORef

4import Data.Word

5import qualified Data.UUID as U

6+import qualified Data.UUID.V1 as U

6import qualified Data.UUID.V4 as U

7import qualified Data.UUID.V4 as U

7import qualified Data.UUID.V3 as U3

8import qualified Data.UUID.V3 as U3

8import qualified Data.UUID.V5 as U5

9import qualified Data.UUID.V5 as U5

uuid/tests/TestUUID.hs+21−5

@@ -1,18 +1,21 @@

1{-# LANGUAGE ViewPatterns #-}

3+import Control.Monad (replicateM)

3import Data.Bits

4import Data.Bits

4import qualified Data.ByteString.Lazy as BL

5import qualified Data.ByteString.Lazy as BL

5import Data.Char (ord)

6import Data.Char (ord)

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

6import Data.Maybe

8import Data.Maybe

7import Data.Word

9import Data.Word

8import qualified Data.UUID as U

10import qualified Data.UUID as U

11+import qualified Data.UUID.V1 as U

9import qualified Data.UUID.V3 as U3

12import qualified Data.UUID.V3 as U3

10import qualified Data.UUID.V5 as U5

13import qualified Data.UUID.V5 as U5

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

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

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

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

14import Test.Tasty.HUnit

17import Test.Tasty.HUnit

15− ( assertBool, (@?=), testCase )

18+ ( Assertable(assert), assertBool, (@?=), testCase )

16import Test.Tasty.QuickCheck ( testProperty )

19import Test.Tasty.QuickCheck ( testProperty )

18type Test = TestTree

21type Test = TestTree

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

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

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

22 where bs = U.toByteString u

25 where bs = U.toByteString u

23 lenOK = BL.length bs == 16

26 lenOK = BL.length bs == 16

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

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

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

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

28instance Arbitrary U.UUID where

31instance Arbitrary U.UUID where

29 -- the UUID random instance ignores bounds

32 -- the UUID random instance ignores bounds

30− arbitrary = pure U.nil

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

33test_null :: Test

36test_null :: Test

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

35 testCase "namespaceDNS is not null" $

38 testCase "namespaceDNS is not null" $

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

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

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

42+test_v1 v1s = testGroup "version 1" [

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

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

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

46+ ]

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

48+ testUUID p u =

49+ testCase (show u) $

50+ assert $ maybe False p u

51+

38test_v3 :: Test

52test_v3 :: Test

39test_v3 =

53test_v3 =

40 testCase "V3 computation" $

54 testCase "V3 computation" $

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

80main :: IO ()

94main :: IO ()

81main = do

95main = do

96+ v1s <- replicateM 100 U.nextUUID

82 defaultMain $

97 defaultMain $

83 testGroup "tests" $

98 testGroup "tests" $

84 concat $

99 concat $

85 [ [

100 [ [

86 test_null,

101 test_null,

102+ test_v1 v1s,

87 test_v3,

103 test_v3,

88 test_v5

104 test_v5

89 ]

105 ]

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

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

1+#!/usr/bin/env perl

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/uuid.cabal+80−85

@@ -1,95 +1,90 @@

1−cabal-version: 1.12

2−name: uuid

1+Name: uuid

3−version: 1.3.16

2+Version: 1.3.13

4−x-revision: 2

6−author: Antoine Latter

4+Author: Antoine Latter

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

5+Maintainer: hvr@gnu.org

8−license: BSD3

6+License: BSD3

9−license-file: LICENSE

7+License-file: LICENSE

10−category: Data

8+Category: Data

11−build-type: Simple

9+Build-Type: Simple

12−tested-with:

10+Cabal-Version: >= 1.10

13− GHC ==8.6.5

11+Tested-With: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2

14− || ==8.8.4

15− || ==8.10.7

16− || ==9.0.2

17− || ==9.2.8

18− || ==9.4.8

19− || ==9.6.6

20− || ==9.8.4

21− || ==9.10.1

22− || ==9.12.1

24−synopsis:

25− For creating, comparing, parsing and printing Universally Unique Identifiers

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

14+Description:

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

16+ printing Universally Unique Identifiers.

17+ .

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

27−description:

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

28− This library is useful for creating, comparing, parsing and

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

29− printing Universally Unique Identifiers.

30− .

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

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

23+Extra-Source-Files:

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

35−extra-source-files: CHANGES.md

24+ CHANGES.md

37−source-repository head

26+Source-Repository head

38− type: git

27+ Type: git

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

28+ Location: https://github.com/hvr/uuid.git

40− subdir: uuid

29+ Subdir: uuid

42−library

31+Library

43− build-depends:

44− base >=4.12 && <5

32+ Build-Depends: base >= 4.3 && < 5,

45− , binary >=0.8.6.0 && <0.9

33+ binary >= 0.4 && < 0.9,

46− , bytestring >=0.10.8.2 && <0.13

34+ bytestring >= 0.10 && < 0.11,

35+ cryptohash-sha1 >= 0.11.100 && < 0.12,

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

36+ cryptohash-md5 >= 0.11.100 && < 0.12,

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

49− , entropy >=0.3.7 && <0.5

37+ entropy >= 0.3.7 && < 0.4,

38+ network-info == 0.2.*,

39+ random >= 1.0.1 && < 1.2,

40+ time >= 1.1 && < 1.8,

41+ text >= 1 && < 1.3,

42+ uuid-types >= 1.0.2 && < 2

51− -- strict dependency on uuid-types,

44+ Exposed-Modules:

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

53− build-depends: uuid-types >=1.0.6 && <1.0.7

54− exposed-modules:

55− Data.UUID

45+ Data.UUID

56− Data.UUID.Util

46+ Data.UUID.Util

47+ Data.UUID.V1

57− Data.UUID.V3

48+ Data.UUID.V3

58− Data.UUID.V4

49+ Data.UUID.V4

59− Data.UUID.V5

50+ Data.UUID.V5

61− other-modules:

52+ Other-Modules:

62− Data.UUID.Named

53+ Data.UUID.Named

63− Data.Word.Util

54+ Data.Word.Util

65− default-language: Haskell2010

56+ Default-Language: Haskell2010

66− default-extensions: DeriveDataTypeable

57+ Default-Extensions: DeriveDataTypeable

67− other-extensions: TypeFamilies

58+ Other-Extensions: TypeFamilies

68− ghc-options: -Wall

59+ Ghc-Options: -Wall

69− if impl(ghc >= 8.10)

70− ghc-options: -Wunused-packages

71− hs-source-dirs: src

73−test-suite testuuid

61+Test-Suite testuuid

74− type: exitcode-stdio-1.0

62+ Type: exitcode-stdio-1.0

75− main-is: TestUUID.hs

63+ Main-is: TestUUID.hs

76− hs-source-dirs: tests

64+ Hs-source-dirs: tests

77− default-language: Haskell2010

65+ Default-Language: Haskell2010

78− default-extensions: DeriveDataTypeable

66+ Default-Extensions: DeriveDataTypeable

79− other-extensions: ViewPatterns

67+ Other-Extensions: ViewPatterns

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

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

81− if impl(ghc >= 8.10)

69+ Build-Depends: uuid

82− ghc-options: -Wunused-packages

70+ Build-Depends: base >= 4.3 && < 5,

71+ bytestring >= 0.9 && < 0.11,

72+ HUnit >= 1.2 && < 1.4,

73+ QuickCheck >= 2.4 && < 2.10,

74+ random >= 1.0.1 && < 1.2,

75+ tasty >= 0.10 && < 0.12,

76+ tasty-hunit == 0.9.*,

77+ tasty-quickcheck == 0.8.*

84− -- inherited constraints

79+benchmark benchmark

85− build-depends:

80+ Type: exitcode-stdio-1.0

86− base

81+ Main-is: BenchUUID.hs

87− , bytestring

82+ Hs-source-dirs: tests

83+ Default-Language: Haskell2010

84+ Default-Extensions: DeriveDataTypeable, CPP

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

88− , uuid

86+ Build-Depends: uuid

89−

87+ Build-Depends: base >= 4.3 && < 5,

90− -- deps w/o inherited constraints

88+ criterion >= 0.4 && < 1.2,

91− build-depends:

89+ mersenne-random-pure64 >= 0.2 && < 0.3,

92− QuickCheck >=2.14.2 && <2.16

90+ random >= 1.0.1 && < 1.2

93− , tasty >=1.4.0.1 && <1.6

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

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