on 2330521 help sign in
39 files changed+707−1334
since splitsnapshots
unifiedsplit
.git-blame-ignore-revs−2 .github/workflows/haskell-ci-bench.yml−241 .github/workflows/haskell-ci.yml−262 .gitignore+2−4 .travis.yml+24 README.md+1−1 cabal.bench.project−4 cabal.haskell-ci−7 cabal.project−15 gen-ci.sh−5 travis-scripts/build.sh+17 uuid-bench/LICENSE−28 uuid-bench/src-uuid−1 uuid-bench/src-uuid-types−1 uuid-bench/uuid-bench.cabal−126 uuid-types/CHANGES+15 uuid-types/ChangeLog.md−31 uuid-types/Data/UUID/Types.hs+39 uuid-types/src/Data/UUID/Types/Internal.hs → uuid-types/Data/UUID/Types/Internal.hs+173−198 uuid-types/src/Data/UUID/Types/Internal/Builder.hs → uuid-types/Data/UUID/Types/Internal/Builder.hs+1−16 uuid-types/cabal.project−1 uuid-types/src/Data/UUID/Types.hs−47 uuid-bench/bench/uuid-types-benchmark.hs → uuid-types/tests/BenchUUID.hs+40−56 uuid-types/tests/TestUUID.hs+15−49 uuid-types/tests/summarize-bench-results.pl+14 uuid-types/uuid-types.cabal+64−86 uuid/CHANGES.md → uuid/CHANGES+23−45 uuid/src/Data/UUID.hs → uuid/Data/UUID.hs+5−5 uuid/src/Data/UUID/Named.hs → uuid/Data/UUID/Named.hs+4−2 uuid/src/Data/UUID/Util.hs → uuid/Data/UUID/Util.hs+11 uuid/Data/UUID/V1.hs+135 uuid/src/Data/UUID/V3.hs → uuid/Data/UUID/V3.hs+3−3 uuid/src/Data/UUID/V4.hs → uuid/Data/UUID/V4.hs+8−7 uuid/src/Data/UUID/V5.hs → uuid/Data/UUID/V5.hs+2−2 uuid/src/Data/Word/Util.hs → uuid/Data/Word/Util.hs uuid-bench/bench/uuid-benchmark.hs → uuid/tests/BenchUUID.hs+3 uuid/tests/TestUUID.hs+21−5 uuid/tests/summarize-bench-results.pl+14 uuid/uuid.cabal+73−84
.git-blame-ignore-revsdeleted−2
@@ -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+2−4
@@ -1,3 +1,4 @@
1+
12# Sandboxing
23.cabal-sandbox/
34cabal.sandbox.config
@@ -5,9 +6,6 @@ cabal.sandbox.config
56# Cabal stuff
67dist/
78cabal.config
8−dist-newstyle/
9−/cabal.project.local
10−.ghc.environment.*
119
1210# Emacs
13−*~
11+*~
.travis.ymlnew file+24
@@ -0,0 +1,24 @@
1+matrix:
2+ include:
3+ - env: CABALVER=1.18 GHCVER=7.6.3
4+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: hvr-ghc}}
5+ - env: CABALVER=1.18 GHCVER=7.8.4
6+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: hvr-ghc}}
7+ - env: CABALVER=1.22 GHCVER=7.10.1
8+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1], sources: hvr-ghc}}
9+ - env: CABALVER=head GHCVER=head
10+ addons: {apt: {packages: [cabal-install-head,ghc-head], sources: hvr-ghc}}
11+ allow_failures:
12+ - env: CABALVER=head GHCVER=head
13+
14+install:
15+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
16+ - cabal --version
17+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
18+ - travis_retry cabal update
19+ - cabal install --only-dependencies --enable-tests --enable-benchmarks uuid-types/uuid-types.cabal uuid/uuid.cabal
20+
21+script:
22+ - for p in uuid-types uuid; do ./travis-scripts/build.sh $p; done
23+
24+sudo: false
README.md+1−1
@@ -1,4 +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)
22
33This library is useful for creating, comparing, parsing and printing Universally
44Unique Identifiers. See http://en.wikipedia.org/wiki/UUID for the general idea.
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
travis-scripts/build.shnew file+17
@@ -0,0 +1,17 @@
1+#!/bin/sh
2+
3+cd $1
4+
5+cabal configure --enable-tests --enable-benchmarks -v2
6+cabal build
7+cabal test
8+cabal check
9+cabal sdist
10+export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
11+cd dist/;
12+if [ -f "$SRC_TGZ" ]; then
13+ cabal install --force-reinstalls "$SRC_TGZ";
14+else
15+ echo "expected '$SRC_TGZ' not found";
16+ exit 1;
17+fi
uuid-bench/LICENSEdeleted−28
@@ -1,28 +0,0 @@
1−Copyright (c) 2008, Antoine Latter
2−
3−All rights reserved.
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:
5− (c) 2017-2018 Herbert Valerio Riedel
6− (c) 2008-2014 Antoine Latter
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
2+
3+- Bump package dependencies
4+
5+1.0.2
6+
7+- Add toText/fromText
8+
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
3+Copyright : (c) 2008,2012 Antoine Latter
4+
5+License : BSD-style
6+
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 #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE ViewPatterns #-}
5−{-# LANGUAGE Unsafe #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE StandaloneDeriving #-}
1+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}
82{-# OPTIONS_HADDOCK hide #-}
93
104-- |
115-- Module : Data.UUID.Types.Internal
12−-- Copyright : (c) 2017-2018 Herbert Valerio Riedel
13−-- (c) 2008-2009, 2012 Antoine Latter
6+-- Copyright : (c) 2008-2009, 2012 Antoine Latter
147-- (c) 2009 Mark Lentczner
158--
169-- License : BSD-style
1710--
18−-- Maintainer : hvr@gnu.org
11+-- Maintainer : aslatter@gmail.com
12+-- Stability : experimental
1913-- Portability : portable
2014
2115module Data.UUID.Types.Internal
22− ( UUID(..)
23− , null
24− , nil
25− , fromByteString
26− , toByteString
27− , fromString
28− , toString
29− , fromText
30− , toText
31− , fromWords
32− , toWords
33− , fromWords64
34− , toWords64
35− , toList
36− , buildFromBytes
37− , buildFromWords
38− , fromASCIIBytes
39− , toASCIIBytes
40− , fromLazyASCIIBytes
41− , toLazyASCIIBytes
42− , UnpackedUUID(..)
43− , pack
44− , unpack
16+ (UUID(..)
17+ ,null
18+ ,nil
19+ ,fromByteString
20+ ,toByteString
21+ ,fromString
22+ ,toString
23+ ,fromText
24+ ,toText
25+ ,fromWords
26+ ,toWords
27+ ,toList
28+ ,buildFromBytes
29+ ,buildFromWords
30+ ,fromASCIIBytes
31+ ,toASCIIBytes
32+ ,fromLazyASCIIBytes
33+ ,toLazyASCIIBytes
34+ ,UnpackedUUID(..)
35+ ,pack
36+ ,unpack
4537 ) where
4638
47−import Prelude hiding (null)
48−
49−import Control.DeepSeq (NFData (..))
50−import Control.Monad (guard, liftM2)
51−import Data.Bits
52−import Data.Char
53−import Data.Data
54−import Data.Hashable
55−import Data.List (elemIndices)
56−import Foreign.Ptr (Ptr)
57−
58−import Foreign.Storable
59−
60−import Data.Binary
61−import Data.Binary.Get
62−import Data.Binary.Put
63−import qualified Data.ByteString as B
64−import qualified Data.ByteString.Internal as BI
65−import qualified Data.ByteString.Lazy as BL
66−import qualified Data.ByteString.Unsafe as BU
67−import Data.Text (Text)
68−import qualified Data.Text.Encoding as T
69−
70−import Data.UUID.Types.Internal.Builder
71−
72−import System.Random (Random (..), uniform)
73−import System.Random.Stateful (Uniform (..), uniformWord64)
74−
75−import Language.Haskell.TH.Syntax (Lift)
76−
77−-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
78−-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
79−data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
80− deriving (Eq, Ord)
39+import Prelude hiding (null)
40+
41+import Control.Applicative ((<*>))
42+import Control.DeepSeq (NFData(..))
43+import Control.Monad (liftM4, guard)
44+import Data.Functor ((<$>))
45+import Data.Char
46+import Data.Bits
47+import Data.Hashable
48+import Data.List (elemIndices)
49+import Foreign.Ptr (Ptr)
50+
51+#if MIN_VERSION_base(4,0,0)
52+import Data.Data
53+#else
54+import Data.Generics.Basics
55+#endif
56+
57+import Foreign.Storable
58+
59+import Data.Binary
60+import Data.Binary.Put
61+import Data.Binary.Get
62+import qualified Data.ByteString as B
63+import qualified Data.ByteString.Internal as BI
64+import qualified Data.ByteString.Lazy as BL
65+import qualified Data.ByteString.Unsafe as BU
66+import Data.Text (Text)
67+import qualified Data.Text as T
68+
69+import Data.UUID.Types.Internal.Builder
70+
71+import System.Random
72+
73+
74+-- |The UUID type. A 'Random' instance is provided which produces
75+-- version 4 UUIDs as specified in RFC 4122. The 'Storable' and
76+-- 'Binary' instances are compatible with RFC 4122, storing the fields
77+-- in network order as 16 bytes.
78+data UUID
79+ = UUID
80+ {-# UNPACK #-} !Word32
81+ {-# UNPACK #-} !Word32
82+ {-# UNPACK #-} !Word32
83+ {-# UNPACK #-} !Word32
84+ deriving (Eq, Ord, Typeable)
8185{-
82− Prior to uuid-types-1.0.4:
83− !Word32 !Word32 !Word32 !Word32
8486 Other representations that we tried are:
8587 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
8688 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
@@ -92,75 +94,40 @@ data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
9294 None was as fast, overall, as the representation used here.
9395-}
9496
95−-- | Convert a 'UUID' into a sequence of 'Word32' values.
97+-- | Covert a 'UUID' into a sequence of 'Word32' values.
9698-- Useful for when you need to serialize a UUID and
9799-- neither 'Storable' nor 'Binary' are appropriate.
98−--
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
100+-- Introduced in version 1.2.2.
107101toWords :: UUID -> (Word32, Word32, Word32, Word32)
108−toWords (UUID w12 w34) = (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
102+toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)
114103
115104-- | 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
117106-- function for constructing 'UUID' values.
118−--
119−-- See also 'fromWords64'.
120−--
121−-- /Since: @uuid-1.2.2@/
122−--
123−-- @since 1.0.0
107+-- Introduced in version 1.2.2.
124108fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
125−fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
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
109+fromWords = UUID
145110
146111data UnpackedUUID =
147112 UnpackedUUID {
148− time_low :: Word32 -- 0-3
149− , time_mid :: Word16 -- 4-5
113+ time_low :: Word32 -- 0-3
114+ , time_mid :: Word16 -- 4-5
150115 , time_hi_and_version :: Word16 -- 6-7
151− , clock_seq_hi_res :: Word8 -- 8
152− , clock_seq_low :: Word8 -- 9
153− , node_0 :: Word8
154− , node_1 :: Word8
155− , node_2 :: Word8
156− , node_3 :: Word8
157− , node_4 :: Word8
158− , node_5 :: Word8
116+ , clock_seq_hi_res :: Word8 -- 8
117+ , clock_seq_low :: Word8 -- 9
118+ , node_0 :: Word8
119+ , node_1 :: Word8
120+ , node_2 :: Word8
121+ , node_3 :: Word8
122+ , node_4 :: Word8
123+ , node_5 :: Word8
159124 }
160125 deriving (Read, Show, Eq, Ord)
161126
162127unpack :: UUID -> UnpackedUUID
163−unpack (UUID w0 w1) = build /-/ w0 /-/ w1
128+unpack (UUID w0 w1 w2 w3) =
129+ build /-/ w0 /-/ w1 /-/ w2 /-/ w3
130+
164131 where
165132 build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =
166133 UnpackedUUID {
@@ -195,26 +162,23 @@ pack unpacked =
195162
196163-- |Build a Word32 from four Word8 values, presented in big-endian order
197164word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
198−word a b c d = (fromIntegral a `unsafeShiftL` 24)
199− .|. (fromIntegral b `unsafeShiftL` 16)
200− .|. (fromIntegral c `unsafeShiftL` 8)
201− .|. (fromIntegral d )
165+word a b c d = (fromIntegral a `shiftL` 24)
166+ .|. (fromIntegral b `shiftL` 16)
167+ .|. (fromIntegral c `shiftL` 8)
168+ .|. (fromIntegral d )
202169
203−-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
204−byte :: Int -> Word64 -> Word8
170+-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,
171+byte :: Int -> Word32 -> Word8
205172byte i w = fromIntegral (w `shiftR` (i * 8))
206173
207174-- |Build a Word16 from two Word8 values, presented in big-endian order.
208175w8to16 :: Word8 -> Word8 -> Word16
209176w8to16 w0s w1s =
210− (w0 `unsafeShiftL` 8) .|. w1
177+ (w0 `shiftL` 8) .|. w1
211178 where
212179 w0 = fromIntegral w0s
213180 w1 = fromIntegral w1s
214181
215−-- | Construct 'Word64' from low/high 'Word32's
216−w32to64 :: Word32 -> Word32 -> Word64
217−w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1)
218182
219183-- |Make a UUID from sixteen Word8 values
220184makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
@@ -223,12 +187,16 @@ makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
223187 -> Word8 -> Word8 -> Word8 -> Word8
224188 -> UUID
225189makeFromBytes 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
227191 where w0 = word b0 b1 b2 b3
228192 w1 = word b4 b5 b6 b7
229193 w2 = word b8 b9 ba bb
230194 w3 = word bc bd be bf
231195
196+-- |Make a UUID from four Word32 values
197+makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
198+makeFromWords = UUID
199+
232200-- |A Builder for constructing a UUID of a given version.
233201buildFromBytes :: Word8
234202 -> 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 =
241209 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
242210 b8' = b8 .&. 0x3f .|. 0x80
243211
244−-- |Build a UUID of a given version from 'Word32' values.
212+-- |Build a UUID of a given version from Word32 values.
245213buildFromWords :: 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
247215 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
248216 w2' = w2 .&. 0x3fffffff .|. 0x80000000
249217
250218
251219-- |Return the bytes that make up the UUID
252220toList :: UUID -> [Word8]
253−toList (UUID w0 w1) =
254− [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0,
255− byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
256− byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1,
257− byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1]
221+toList (UUID w0 w1 w2 w3) =
222+ [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,
224+ byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,
225+ byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]
258226
259227-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
260228-- exactly sixteen bytes long
@@ -275,10 +243,10 @@ null = (== nil)
275243 -- null (UUID 0 0 0 0) = True
276244 -- null _ = False
277245
278−-- |The 'nil' UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
279−-- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@.
246+-- |The nil UUID, as defined in RFC 4122.
247+-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
280248nil :: UUID
281−nil = UUID 0 0
249+nil = UUID 0 0 0 0
282250
283251-- |Extract a UUID from a 'ByteString' in network byte order.
284252-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
@@ -286,8 +254,6 @@ fromByteString :: BL.ByteString -> Maybe UUID
286254fromByteString = fromList . BL.unpack
287255
288256-- |Encode a UUID into a 'ByteString' in network order.
289−--
290−-- This uses the same encoding as the 'Binary' instance.
291257toByteString :: UUID -> BL.ByteString
292258toByteString = BL.pack . toList
293259
@@ -295,8 +261,9 @@ toByteString = BL.pack . toList
295261-- The hyphens may not be omitted.
296262-- Example:
297263--
298−-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"
299−-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c
264+-- @
265+-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
266+-- @
300267--
301268-- Hex digits may be upper or lower-case.
302269fromString :: String -> Maybe UUID
@@ -311,7 +278,7 @@ fromString' s0 = do
311278 (w2, s3) <- hexWord s2
312279 (w3, s4) <- hexWord s3
313280 if s4 /= "" then Nothing
314− else Just $ fromWords w0 w1 w2 w3
281+ else Just $ UUID w0 w1 w2 w3
315282 where hexWord :: String -> Maybe (Word32, String)
316283 hexWord s = Just (0, s) >>= hexByte >>= hexByte
317284 >>= hexByte >>= hexByte
@@ -328,39 +295,30 @@ fromString' s0 = do
328295-- | Convert a UUID into a hypenated string using lower-case letters.
329296-- Example:
330297--
331−-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
332−-- Just "550e8400-e29b-41d4-a716-446655440000"
333−--
334−--
298+-- @
299+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
300+-- @
335301toString :: UUID -> String
336−toString uuid = hexw0 w0 $ hexw1 w1 ""
337− where hexw0 :: Word64 -> 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
341− : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
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)
302+toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
303+ where hexw :: Word32 -> String -> String
304+ hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
305+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
306+
307+ hexw' :: Word32 -> String -> String
308+ hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
309+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
353310
354− (w0,w1) = toWords64 uuid
311+ hexn :: Word32 -> Int -> Char
312+ hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
355313
356314-- | If the passed in `Text` can be parsed as an ASCII representation of
357315-- a `UUID`, it will be. The hyphens may not be omitted.
358316fromText :: Text -> Maybe UUID
359−fromText = fromASCIIBytes . T.encodeUtf8
317+fromText = fromString . T.unpack
360318
361319-- | Convert a UUID into a hyphentated string using lower-case letters.
362320toText :: UUID -> Text
363−toText = T.decodeLatin1 . toASCIIBytes
321+toText = T.pack . toString
364322
365323-- | Convert a UUID into a hyphentated string using lower-case letters, packed
366324-- as ASCII bytes into `B.ByteString`.
@@ -455,30 +413,49 @@ fromASCIIBytes bs = do
455413-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
456414toLazyASCIIBytes :: UUID -> BL.ByteString
457415toLazyASCIIBytes =
416+#if MIN_VERSION_bytestring(0,10,0)
458417 BL.fromStrict
418+#else
419+ BL.fromChunks . return
420+#endif
459421 . toASCIIBytes
460422
461423-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
462424fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
463425fromLazyASCIIBytes 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
465433
466434--
467435-- Class Instances
468436--
469437
470−-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471−-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
472438instance 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
474445 randomR _ = random -- range is ignored
475446
476−-- @since 1.0.4
477−instance Uniform UUID where
478− uniformM gen = do
479− w0 <- uniformWord64 gen
480− w1 <- uniformWord64 gen
481− pure $ buildFromBytes 4 /-/ w0 /-/ w1
447+-- |Build a UUID from the results of five calls to next on a StdGen.
448+-- While next on StdGet returns an Int, it doesn't provide 32 bits of
449+-- randomness. This code relies on at last 28 bits of randomness in the
450+-- and optimizes its use so as to make only five random values, not six.
451+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
452+fromGenNext w0 w1 w2 w3 w4 =
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)
482459
483460-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
484461-- only returns 31 bits of randomness.
@@ -486,29 +463,24 @@ type instance ByteSink ThreeByte g = Takes3Bytes g
486463newtype ThreeByte = ThreeByte Int
487464instance ByteSource ThreeByte where
488465 f /-/ (ThreeByte w) = f b1 b2 b3
489− where b1 = fromIntegral (w `unsafeShiftR` 16)
490− b2 = fromIntegral (w `unsafeShiftR` 8)
466+ where b1 = fromIntegral (w `shiftR` 16)
467+ b2 = fromIntegral (w `shiftR` 8)
491468 b3 = fromIntegral w
492469
493470instance NFData UUID where
494− rnf = flip seq ()
471+ rnf = rnf . toWords
495472
496473instance Hashable UUID where
497− hash (toWords -> (w0,w1,w2,w3)) =
474+ hash (UUID w0 w1 w2 w3) =
498475 hash w0 `hashWithSalt` w1
499476 `hashWithSalt` w2
500477 `hashWithSalt` w3
501− hashWithSalt s (toWords -> (w0,w1,w2,w3)) =
478+ hashWithSalt s (UUID w0 w1 w2 w3) =
502479 s `hashWithSalt` w0
503480 `hashWithSalt` w1
504481 `hashWithSalt` w2
505482 `hashWithSalt` w3
506483
507−-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
508−--
509−-- >>> show nil
510−-- "00000000-0000-0000-0000-000000000000"
511−--
512484instance Show UUID where
513485 show = toString
514486
@@ -519,7 +491,7 @@ instance Read UUID where
519491 Nothing -> []
520492 Just u -> [(u,drop 36 noSpaces)]
521493
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+
523495instance Storable UUID where
524496 sizeOf _ = 16
525497 alignment _ = 4
@@ -556,10 +528,10 @@ instance Storable UUID where
556528 pokeByteOff p (off+14) x9
557529 pokeByteOff p (off+15) x10
558530
559−-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.
560531instance Binary UUID where
561− put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
562− get = liftM2 UUID getWord64be getWord64be
532+ put (UUID w0 w1 w2 w3) =
533+ putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3
534+ get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be
563535
564536
565537-- My goal with this instance was to make it work just enough to do what
@@ -572,4 +544,7 @@ instance Data UUID where
572544uuidType :: DataType
573545uuidType = mkNoRepType "Data.UUID.Types.UUID"
574546
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 @@
11{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE Unsafe #-}
3−
42{-# OPTIONS_HADDOCK hide #-}
53
6−-- | Module : Data.UUID.Types.Internal.Builder
4+-- Module : Data.UUID.Types.Internal.Builder
75-- Copyright : (c) 2009 Mark Lentczner
86--
97-- License : BSD-style
@@ -49,7 +47,6 @@ type Takes1Byte g = Word8 -> g
4947type Takes2Bytes g = Word8 -> Word8 -> g
5048type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g
5149type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g
52−type Takes8Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> g
5350
5451-- | Type of function that a given ByteSource needs.
5552-- This function must take as many Word8 arguments as the ByteSource provides
@@ -57,7 +54,6 @@ type family ByteSink w g
5754type instance ByteSink Word8 g = Takes1Byte g
5855type instance ByteSink Word16 g = Takes2Bytes g
5956type instance ByteSink Word32 g = Takes4Bytes g
60−type instance ByteSink Word64 g = Takes8Bytes g
6157type instance ByteSink Int g = Takes4Bytes g
6258
6359
@@ -85,17 +81,6 @@ instance ByteSource Word32 where
8581 b3 = fromIntegral (w `shiftR` 8)
8682 b4 = fromIntegral w
8783
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−
9984instance ByteSource Int where
10085 f /-/ w = f b1 b2 b3 b4
10186 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
5−Copyright : (c) 2017-2018 Herbert Valerio Riedel
6− (c) 2008,2012 Antoine Latter
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+40−56
@@ -1,22 +1,19 @@
11{-# LANGUAGE CPP #-}
22
33#if !(MIN_VERSION_bytestring(0,10,0))
4−{-# OPTIONS_GHC -fno-warn-orphans #-}
54-- Needed for NFData instance
6−import Control.DeepSeq
5+import Control.DeepSeq
76import qualified Data.ByteString.Lazy.Internal as BL
87#endif
9−import Criterion.Main
10−import qualified Data.ByteString.Lazy as BL
11−import qualified Data.HashSet as HashSet
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)
16−import System.Random
8+import Criterion.Main
9+import Data.Maybe (fromJust)
10+import qualified Data.Set as Set
11+import qualified Data.ByteString.Lazy as BL
12+import qualified Data.UUID.Types as U
13+import Foreign (alloca, peek, poke)
14+import System.Random
1715
1816#if !(MIN_VERSION_bytestring(0,10,0))
19−-- orphan
2017instance NFData BL.ByteString where
2118 rnf BL.Empty = ()
2219 rnf (BL.Chunk _ ts) = rnf ts
@@ -24,56 +21,43 @@ instance NFData BL.ByteString where
2421
2522main :: IO ()
2623main = do
27− u1 <- randomIO
28− let s1 = U.toString u1
29− b1 = U.toByteString u1
30− a1 = U.toASCIIBytes u1
31− t1 = U.toText u1
32− (w1a,w1b,w1c,w1d) = U.toWords u1
33− nil2 = fromJust $
34− U.fromString "00000000-0000-0000-0000-000000000000"
35− u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"
36− u2b = fromJust $ U.fromByteString $
37− BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,
38− 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]
39− u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"
24+ u1 <- randomIO
25+ let s1 = U.toString u1
26+ b1 = U.toByteString u1
27+ nil2 = fromJust $
28+ U.fromString "00000000-0000-0000-0000-000000000000"
29+ u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"
30+ u2b = fromJust $ U.fromByteString $
31+ BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,
32+ 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]
33+ u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"
4034
41− -- setup for Storable benchmark
42− alloca $ \ uuidPtr -> do
35+ -- setup for Storable benchmark
36+ alloca $ \ uuidPtr -> do
4337
44− poke uuidPtr u1
38+ poke uuidPtr u1
4539
46− defaultMain [
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− ],
40+ defaultMain [
41+ bgroup "testing" [
42+ bench "null non-nil" $ whnf U.null u1,
43+ bench "null nil" $ whnf U.null U.nil,
44+ bench "null nil2" $ whnf U.null nil2,
45+ bench "eq same" $ whnf (==u2a) u2b,
46+ bench "eq differ" $ whnf (==u2a) u3
47+ ],
48+ bgroup "conversion" [
49+ bench "toString" $ nf U.toString u1,
50+ bench "fromString" $ nf U.fromString s1,
51+ bench "toByteString" $ nf U.toByteString u1,
52+ bench "fromByteString" $ nf U.fromByteString b1
53+ ],
54+ bench "set making" $ nf Set.fromList uuids,
6855
69− bench "Set making" $ nf Set.fromList uuids,
70− bench "HashSet making" $ nf HashSet.fromList uuids,
71−
72− bgroup "storable" [
73− bench "peek" $ nfIO (peek uuidPtr),
74− bench "poke" $ whnfIO $ poke uuidPtr u1
56+ bgroup "storable" [
57+ bench "peek" $ nfIO (peek uuidPtr),
58+ bench "poke" $ whnfIO $ poke uuidPtr u1
59+ ]
7560 ]
76− ]
7761
7862-- 50 uuids, so tests can be repeatable
7963uuids :: [U.UUID]
uuid-types/tests/TestUUID.hs+15−49
@@ -1,29 +1,22 @@
11{-# LANGUAGE ViewPatterns #-}
2−{-# LANGUAGE TemplateHaskell #-}
32
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
94import qualified Data.ByteString.Lazy.Char8 as BL8
10−import Data.Char (ord)
11−import Data.Functor ((<$>))
12−import qualified Data.UUID.Types as U
13−import Data.Word
14−import Foreign (alloca, castPtr, peek, poke,
15− sizeOf)
16−import GHC.ByteOrder (ByteOrder(..), targetByteOrder)
17−import System.IO.Unsafe (unsafePerformIO)
5+import qualified Data.ByteString.Char8 as BC8
6+import Data.Char (ord)
7+import Data.Functor ((<$>))
8+import Data.Word
9+import qualified Data.UUID.Types as U
10+import Foreign (alloca, peek, poke)
11+import System.IO.Unsafe (unsafePerformIO)
1812
19−import Test.QuickCheck (Arbitrary (arbitrary), choose)
13+import Test.QuickCheck ( Arbitrary(arbitrary), choose )
2014
21−import Test.Tasty (TestTree, defaultMain, testGroup)
22−import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))
23−import Test.Tasty.QuickCheck (testProperty)
15+import Test.Tasty ( defaultMain, TestTree, testGroup )
16+import Test.Tasty.HUnit ( assertBool, (@?=), (@=?), testCase )
17+import Test.Tasty.QuickCheck ( testProperty )
2418
2519
26−-- orphan
2720instance Arbitrary U.UUID where
2821 -- the UUID random instance ignores bounds
2922 arbitrary = choose (U.nil, U.nil)
@@ -41,11 +34,6 @@ test_nil = testGroup "nil" [
4134 testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)
4235 ]
4336
44−test_lift :: Test
45−test_lift = testCase "TH.Lift" $ do
46− let uuid = U.fromWords64 123456789 987654321
47− uuid @?= $( [| uuid |] )
48−
4937test_conv :: Test
5038test_conv = testGroup "conversions" [
5139 testCase "conv bytes to string" $
@@ -61,32 +49,13 @@ test_fromByteString :: Test
6149test_fromByteString =
6250 testCase "UUID fromByteString" $
6351 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")
6553
6654-- | Test fromWords with a fixed-input
6755test_fromWords :: Test
6856test_fromWords =
6957 testCase "UUID fromWords" $
70− inputUUID @=? U.fromWords 0xa5ca8566 0xd9c54835 0x99c8e1f1 0x3e73b5e2
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
58+ inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594
9059
9160inputUUID :: U.UUID
9261inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
@@ -182,12 +151,9 @@ main = do
182151 [ [
183152 test_null,
184153 test_nil,
185− test_lift,
186154 test_conv,
187155 test_fromByteString,
188− test_fromWords,
189− test_Storeable,
190− test_Binary
156+ test_fromWords
191157 ]
192158 , [ prop_stringRoundTrip,
193159 prop_readShowRoundTrip,
uuid-types/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-types/uuid-types.cabal+64−86
@@ -1,99 +1,77 @@
1−cabal-version: 1.12
2−name: uuid-types
3−version: 1.0.6
4−x-revision: 2
5−copyright:
6− (c) 2017-2018 Herbert Valerio Riedel
7− (c) 2008-2014 Antoine Latter
1+Name: uuid-types
2+Version: 1.0.3
3+Copyright: (c) 2008-2014 Antoine Latter
4+Author: Antoine Latter
5+Maintainer: aslatter@gmail.com
6+License: BSD3
7+License-file: LICENSE
88
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
9+Category: Data
10+Build-Type: Simple
11+Cabal-Version: >= 1.8
2612
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.
13+Description:
14+ This library contains type definitions for Universally Unique Identifiers
15+ and basic conversion functions.
3716
38−homepage: https://github.com/haskell-hvr/uuid
39−bug-reports: https://github.com/haskell-hvr/uuid/issues
40−extra-source-files: ChangeLog.md
17+ See <http://en.wikipedia.org/wiki/UUID> for the general idea.
4118
42−source-repository head
43− type: git
44− location: https://github.com/haskell-hvr/uuid.git
45− subdir: uuid-types
19+Synopsis: Type definitions for Universally Unique Identifiers
4620
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
21+Homepage: https://github.com/aslatter/uuid
22+Bug-Reports: https://github.com/aslatter/uuid/issues
5723
58− exposed-modules: Data.UUID.Types
24+Extra-Source-Files:
25+ CHANGES
5926
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
6427
65− default-language: Haskell2010
66− other-extensions:
67− DeriveDataTypeable
68− TypeFamilies
28+Library
29+ Build-Depends: base >=3 && < 5,
30+ binary >= 0.4 && < 0.9,
31+ bytestring >= 0.9 && < 0.11,
32+ deepseq >= 1.3 && < 1.5,
33+ hashable (>= 1.1.1.0 && < 1.2.0) || (>= 1.2.1 && < 1.3),
34+ random >= 1.0.1 && < 1.2,
35+ text >= 1 && < 1.3
6936
70− ghc-options: -Wall
71− hs-source-dirs: src
37+ Exposed-Modules:
38+ Data.UUID.Types
39+ -- Exposed for companion projects; *NOT* part of the official API:
40+ Data.UUID.Types.Internal.Builder
41+ Data.UUID.Types.Internal
7242
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
43+ Extensions: DeriveDataTypeable
44+ Ghc-Options: -Wall
8245
83− -- inherited constraints
84− build-depends:
85− base
86− , binary
87− , bytestring
88− , template-haskell
89− , uuid-types
46+source-repository head
47+ type: git
48+ location: https://github.com/aslatter/uuid.git
9049
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
50+Test-Suite testuuid
51+ Type: exitcode-stdio-1.0
52+ Main-is: TestUUID.hs
53+ Hs-source-dirs: tests
54+ Extensions: DeriveDataTypeable
55+ Ghc-Options: -Wall -fno-warn-orphans
56+ Build-Depends: base >= 3 && < 5,
57+ uuid-types,
58+ bytestring >= 0.9 && < 0.11,
59+ HUnit >=1.2 && < 1.4,
60+ QuickCheck >=2.4 && < 2.9,
61+ tasty >= 0.10 && < 0.12,
62+ tasty-hunit == 0.9.*,
63+ tasty-quickcheck == 0.8.*
9764
98− if !impl(ghc >=8.4)
99− build-depends: ghc-byteorder >=4.11 && <4.12
65+benchmark benchmark
66+ Type: exitcode-stdio-1.0
67+ Main-is: BenchUUID.hs
68+ Hs-source-dirs: tests
69+ Extensions: DeriveDataTypeable, CPP
70+ Ghc-Options: -Wall -fno-warn-orphans
71+ Build-depends: base == 4.*,
72+ uuid-types,
73+ bytestring >= 0.9 && < 0.11,
74+ containers >= 0.4 && < 0.6,
75+ criterion >= 0.4 && < 1.2,
76+ deepseq >= 1.1 && < 1.5,
77+ random >= 1.0.1 && < 1.2
uuid/CHANGES.md → uuid/CHANGESrenamed+23−45
@@ -1,25 +1,3 @@
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−
2311.3.12
242
253- Update package dependencies
@@ -32,7 +10,7 @@
3210
33111.3.11
3412
35−- Add `toText`/`fromText`
13+- Add toText/fromText
3614
37151.3.10
3816
@@ -45,11 +23,11 @@
4523
46241.3.8
4725
48−- Allow building against newer `deepseq`.
26+- Allow building against newer deepseq.
4927
50281.3.7
5129
52−- Allow building against newer `time`.
30+- Allow building against newer time.
5331
54321.3.6
5533
@@ -57,58 +35,58 @@
5735
58361.3.5
5937
60−- Allow building against newer `random`.
38+- Allow building against newer random.
6139
62401.3.4
6341
64−- Allow building against newer `QuickCheck`.
42+- Allow building against newer QuickCheck.
6543
66441.3.3
6745
68−- More complex version constraints on `hashable`, to avoid building against
46+- More complex version constrainsts on hashable, to avoid building against
6947 versions less than 1.1.1.0 or equal to 1.2.0.*.
7048
71491.3.2
7250
73−- Fix for building against `bytestring` 0.9.*
51+- Fix for building against bytestring 0.9.*
7452
75531.3.1
7654
77−- Allow building against `hashable` 1.1.* in addition to 1.2.*
55+- Allow building against 'hashable' 1.1.* in addition to 1.2.*
7856
79571.3.0
8058
8159- New functions for parsing and printing UUIDs to and from ASCII BytesStrings
82−- New module `Data.UUID.Util`. This module includes the type `UnpackedUUID`,
60+- New module Data.UUID.Util. This module includes the type 'UnpackedUUID',
8361 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
62+- The Storable instance now stores a UUID in host byte-order instead of
8563 big endian.
86−- There is now an instance for `Hashable UUID`.
64+- There is now an instance for 'Hashable UUID'.
8765
88661.2.13
8967
9068Benchmark only changes:
9169
92−- Allow `criterion` 0.8.*
70+- Allow criterion 0.8.*
9371
94721.2.12
9573
9674Test only changes:
9775
98−- Allow `QuickCheck` 2.6.*
76+- Allow QuickCheck 2.6.*
9977
100781.2.11
10179
102−- Allow `binary` 0.7.*
80+- Allow binary 0.7.*
10381
104821.2.10
10583
106−- Allow `cryptohash` version 0.9.*
84+- Allow cryptohash version 0.9.*
10785- Cleanup tests
10886
109871.2.9
11088
111−- Bumped dependency on `cryptohash`.
89+- Bumped dependency on 'cryptohash'.
11290
113911.2.8
11492
@@ -116,13 +94,13 @@ Test only changes:
11694
117951.2.7
11896
119−- Added stricter constraints on `random` package.
97+- Added stricter constraints on 'random' package.
12098
121991.2.6
122100
123−- Add module `V4` to direct attention to our Random instance
101+- Add module 'V4' to direct attention to our Random instance
124102
125−- In module `V1` seed the generator with a random number
103+- In module 'V1' seed the generator with a random number
126104 if the hardware MAC address could not be discovered.
127105
128106- Fix and cleanup various haddocks.
@@ -132,7 +110,7 @@ Test only changes:
132110
1331111.2.5
134112
135−- Use `cryptohash` package for MD5 and SHA1 instead of `Crypto`
113+- Use 'cryptohash' package for MD5 and SHA1 instead of 'Crypto'
136114
1371151.2.4
138116
@@ -165,7 +143,7 @@ and a test case)
165143 (Contributors: Antoine Latter & Mark Lentczner)
166144
167145- added functions toByteString and fromByteString
168−- added `nil` UUID
146+- added 'nil' UUID
169147- added unit tests and benchmarks, built when configured -ftest
170148- major speed up of to/from functions (as well as in general)
171149- added version-3 generation (deterministic based on MD5)
@@ -181,6 +159,6 @@ and a test case)
181159
1821601.1.1
183161
184−- no longer exporting `null` from the prelude
185−- add `null` predicate on UUIDs
162+- no longer exporting 'null' from the prelude
163+- add 'null' predicate on UUIDs
186164- documentation fix (thanks Mark Lentczner)
uuid/src/Data/UUID.hs → uuid/Data/UUID.hsrenamed+5−5
@@ -14,9 +14,11 @@ printing Universally Unique Identifiers.
1414See <http://en.wikipedia.org/wiki/UUID> for the general idea.
1515See <http://tools.ietf.org/html/rfc4122> for the specification.
1616
17−* Use 'Data.UUID.V4.nextRandom' to generate secure random UUIDs, and your
18−favorite instance of 'System.Random.Random' for faster but insecure
19−generation of UUIDs.
17+* Random UUIDs may be generated using 'Data.UUID.V4.nextRandom' or
18+your favorite instance of 'System.Random.Random'.
19+
20+* We have an implementation of generating a UUID from the hardware
21+MAC address and current system time in "Data.UUID.V1".
2022
2123* For name-based generation of UUIDs using SHA-1 hashing see
2224"Data.UUID.V5".
@@ -34,8 +36,6 @@ module Data.UUID(UUID
3436 ,fromByteString
3537 ,toWords
3638 ,fromWords
37− ,toWords64
38− ,fromWords64
3939 ,null
4040 ,nil
4141 ) where
uuid/src/Data/UUID/Named.hs → uuid/Data/UUID/Named.hsrenamed+4−2
@@ -33,19 +33,21 @@ import Data.Binary.Get (runGet, getWord32be)
3333import Data.Maybe
3434import Data.Word (Word8)
3535
36+import qualified Data.ByteArray as BA
3637import qualified Data.ByteString as B
3738import qualified Data.ByteString.Lazy as BL
3839
3940-- |Generate a 'UUID' within the specified namespace out of the given
4041-- object.
41−generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash
42+generateNamed :: BA.ByteArrayAccess bs
43+ => (B.ByteString -> bs) -- ^Hash
4244 -> Word8 -- ^Version
4345 -> UUID -- ^Namespace
4446 -> [Word8] -- ^Object
4547 -> UUID
4648generateNamed hash version namespace object =
4749 let chunk = B.pack $ toList namespace ++ object
48− bytes = BL.fromChunks . (:[]) $ hash chunk
50+ bytes = BL.fromStrict . BA.convert $ hash chunk
4951 w = getWord32be
5052 unpackBytes = runGet $
5153 buildFromWords version <$> w <*> w <*> w <*> w
uuid/src/Data/UUID/Util.hs → uuid/Data/UUID/Util.hsrenamed+11
@@ -3,6 +3,7 @@ module Data.UUID.Util (
33 UnpackedUUID(..)
44 , unpack, pack
55 , version
6+ , extractMac
67 , extractTime
78 , setTime
89 ) where
@@ -12,6 +13,7 @@ import Data.Word
1213import Data.Word.Util
1314import Data.Bits
1415import Data.UUID.Types.Internal
16+import Network.Info
1517import Data.Int (Int64)
1618
1719version :: UUID -> Int
@@ -40,3 +42,12 @@ extractTime uuid =
4042
4143timeAndVersionToTime :: Word16 -> Word16
4244timeAndVersionToTime 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 #-}
3+
4+{- |
5+Module : Data.UUID.V1
6+Copyright : (c) 2008 Jason Dusek
7+ (c) 2009 Mark Lentczner
8+ (c) 2009-2010,2012 Antoine Latter
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.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+3−3
@@ -8,7 +8,7 @@ Maintainer : aslatter@gmail.com
88Stability : experimental
99Portability : portable
1010
11−NOTE\: This module uses MD5 hashing. Unless you know
11+NOTE: This module uses MD5 hashing. Unless you know
1212you need to use this module, you should probably be
1313using "Data.UUID.V5", which offers the same sort of
1414functionality as this module except implemented with
@@ -35,7 +35,7 @@ import Data.Word
3535
3636import Data.UUID.Types.Internal
3737import qualified Data.UUID.Named as Shared
38−import qualified Crypto.Hash.MD5 as MD5
38+import qualified Crypto.Hash as H
3939
4040
4141-- |Generate a 'UUID' within the specified namespace out of the given
@@ -46,4 +46,4 @@ import qualified Crypto.Hash.MD5 as MD5
4646generateNamed :: UUID -- ^Namespace
4747 -> [Word8] -- ^Object
4848 -> UUID
49−generateNamed = Shared.generateNamed MD5.hash 3
49+generateNamed = Shared.generateNamed (H.hashWith H.MD5) 3
uuid/src/Data/UUID/V4.hs → uuid/Data/UUID/V4.hsrenamed+8−7
@@ -11,21 +11,22 @@
1111 This module implements Version 4 UUIDs as specified
1212 in RFC 4122.
1313
14− These UUIDs are generated from a pseudo-random generator.
15− We use the 'getEntropy' method from the <https://hackage.haskell.org/package/entropy entropy> package,
16− which should provide cryptographically secure random data.
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.
1720-}
1821module Data.UUID.V4 (nextRandom) where
1922
2023import Data.UUID
2124import Data.UUID.Types.Internal ( buildFromBytes )
2225
23−import System.Entropy ( getEntropy )
26+import Crypto.Random.Entropy ( getEntropy )
2427import Data.ByteString ( unpack )
2528
26−-- | Generate a crytographically secure, random UUID.
27−--
28−-- @since 1.2.6
29+-- | Generate a random UUID. Introduced in version 1.2.6.
2930nextRandom :: IO UUID
3031nextRandom = do
3132 [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+2−2
@@ -30,7 +30,7 @@ import Data.Word
3030
3131import Data.UUID.Types.Internal
3232import qualified Data.UUID.Named as Shared
33−import qualified Crypto.Hash.SHA1 as SHA1
33+import qualified Crypto.Hash as H
3434
3535
3636-- |Generate a 'UUID' within the specified namespace out of the given
@@ -41,4 +41,4 @@ import qualified Crypto.Hash.SHA1 as SHA1
4141generateNamed :: UUID -- ^Namespace
4242 -> [Word8] -- ^Object
4343 -> UUID
44−generateNamed = Shared.generateNamed SHA1.hash 5
44+generateNamed = Shared.generateNamed (H.hashWith H.SHA1) 5
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+3
@@ -1,8 +1,11 @@
1+{-# LANGUAGE CPP #-}
2+
13import Criterion.Main
24import Data.Char (ord)
35import Data.IORef
46import Data.Word
57import qualified Data.UUID as U
8+import qualified Data.UUID.V1 as U
69import qualified Data.UUID.V4 as U
710import qualified Data.UUID.V3 as U3
811import qualified Data.UUID.V5 as U5
uuid/tests/TestUUID.hs+21−5
@@ -1,18 +1,21 @@
11{-# LANGUAGE ViewPatterns #-}
22
3+import Control.Monad (replicateM)
34import Data.Bits
45import qualified Data.ByteString.Lazy as BL
56import Data.Char (ord)
7+import Data.List (nub, (\\))
68import Data.Maybe
79import Data.Word
810import qualified Data.UUID as U
11+import qualified Data.UUID.V1 as U
912import qualified Data.UUID.V3 as U3
1013import qualified Data.UUID.V5 as U5
1114
12−import Test.QuickCheck ( Arbitrary(arbitrary) )
15+import Test.QuickCheck ( Arbitrary(arbitrary), choose )
1316import Test.Tasty ( TestTree, testGroup, defaultMain )
1417import Test.Tasty.HUnit
15− ( assertBool, (@?=), testCase )
18+ ( Assertable(assert), assertBool, (@?=), testCase )
1619import Test.Tasty.QuickCheck ( testProperty )
1720
1821type Test = TestTree
@@ -21,13 +24,13 @@ isValidVersion :: Int -> U.UUID -> Bool
2124isValidVersion v u = lenOK && variantOK && versionOK
2225 where bs = U.toByteString u
2326 lenOK = BL.length bs == 16
24− variantOK = BL.index bs 8 .&. 0xc0 == 0x80
25− versionOK = BL.index bs 6 .&. 0xf0 == fromIntegral (v `shiftL` 4)
27+ variantOK = (BL.index bs 8) .&. 0xc0 == 0x80
28+ versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
2629
2730
2831instance Arbitrary U.UUID where
2932 -- the UUID random instance ignores bounds
30− arbitrary = pure U.nil
33+ arbitrary = choose (U.nil, U.nil)
3134
3235
3336test_null :: Test
@@ -35,6 +38,17 @@ test_null =
3538 testCase "namespaceDNS is not null" $
3639 assertBool "" (not $ U.null U3.namespaceDNS)
3740
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+
3852test_v3 :: Test
3953test_v3 =
4054 testCase "V3 computation" $
@@ -79,11 +93,13 @@ prop_v5Valid = testProperty "V5 valid" v5Valid
7993
8094main :: IO ()
8195main = do
96+ v1s <- replicateM 100 U.nextUUID
8297 defaultMain $
8398 testGroup "tests" $
8499 concat $
85100 [ [
86101 test_null,
102+ test_v1 v1s,
87103 test_v3,
88104 test_v5
89105 ]
uuid/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/uuid.cabal+73−84
@@ -1,95 +1,84 @@
1−cabal-version: 1.12
2−name: uuid
3−version: 1.3.16
4−x-revision: 2
5−copyright: (c) 2008-2014 Antoine Latter
6−author: Antoine Latter
7−maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
8−license: BSD3
9−license-file: LICENSE
10−category: Data
11−build-type: Simple
12−tested-with:
13− GHC ==8.6.5
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
1+Name: uuid
2+Version: 1.3.12
3+Copyright: (c) 2008-2014 Antoine Latter
4+Author: Antoine Latter
5+Maintainer: aslatter@gmail.com
6+License: BSD3
7+License-file: LICENSE
238
24−synopsis:
25− For creating, comparing, parsing and printing Universally Unique Identifiers
9+Category: Data
10+Build-Type: Simple
11+Cabal-Version: >= 1.8
2612
27−description:
28− This library is useful for creating, comparing, parsing and
29− printing Universally Unique Identifiers.
30− .
31− See <http://en.wikipedia.org/wiki/UUID> for the general idea.
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.
3217
33−homepage: https://github.com/haskell-hvr/uuid
34−bug-reports: https://github.com/haskell-hvr/uuid/issues
35−extra-source-files: CHANGES.md
18+Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers
3619
37−source-repository head
38− type: git
39− location: https://github.com/haskell-hvr/uuid.git
40− subdir: uuid
20+Homepage: https://github.com/aslatter/uuid
21+Bug-Reports: https://github.com/aslatter/uuid/issues
4122
42−library
43− build-depends:
44− base >=4.12 && <5
45− , binary >=0.8.6.0 && <0.9
46− , bytestring >=0.10.8.2 && <0.13
47− , cryptohash-md5 >=0.11.100 && <0.12
48− , cryptohash-sha1 >=0.11.100 && <0.12
49− , entropy >=0.3.7 && <0.5
23+Extra-Source-Files:
24+ CHANGES
5025
51− -- strict dependency on uuid-types,
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
56− Data.UUID.Util
57− Data.UUID.V3
58− Data.UUID.V4
59− Data.UUID.V5
6026
61− other-modules:
62− Data.UUID.Named
63− Data.Word.Util
27+Library
28+ Build-Depends: base >=3 && < 5,
29+ binary >= 0.4 && < 0.9,
30+ bytestring >= 0.9 && < 0.11,
31+ cryptonite,
32+ memory,
33+ network-info == 0.2.*,
34+ random >= 1.0.1 && < 1.2,
35+ time >= 1.1 && < 1.7,
36+ text >= 1 && < 1.3,
37+ uuid-types >= 1.0.2 && < 2
6438
65− default-language: Haskell2010
66− default-extensions: DeriveDataTypeable
67− other-extensions: TypeFamilies
68− ghc-options: -Wall
69− if impl(ghc >= 8.10)
70− ghc-options: -Wunused-packages
71− hs-source-dirs: src
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
7246
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− default-extensions: DeriveDataTypeable
79− other-extensions: ViewPatterns
80− ghc-options: -Wall -fno-warn-orphans
81− if impl(ghc >= 8.10)
82− ghc-options: -Wunused-packages
47+ Other-Modules:
48+ Data.UUID.Named
49+ Data.Word.Util
8350
84− -- inherited constraints
85− build-depends:
86− base
87− , bytestring
88− , uuid
51+ Extensions: DeriveDataTypeable
52+ Ghc-Options: -Wall
8953
90− -- deps w/o inherited constraints
91− build-depends:
92− QuickCheck >=2.14.2 && <2.16
93− , tasty >=1.4.0.1 && <1.6
94− , tasty-hunit >=0.10 && <0.11
95− , tasty-quickcheck >=0.10 && <0.12
54+source-repository head
55+ type: git
56+ location: https://github.com/aslatter/uuid.git
57+
58+Test-Suite testuuid
59+ Type: exitcode-stdio-1.0
60+ Main-is: TestUUID.hs
61+ Hs-source-dirs: tests
62+ Extensions: DeriveDataTypeable
63+ Ghc-Options: -Wall -fno-warn-orphans
64+ Build-Depends: base >= 3 && < 5,
65+ uuid,
66+ bytestring >= 0.9 && < 0.11,
67+ HUnit >=1.2 && < 1.4,
68+ QuickCheck >=2.4 && < 2.9,
69+ random >= 1.0.1 && < 1.2,
70+ tasty >= 0.10 && < 0.12,
71+ tasty-hunit == 0.9.*,
72+ tasty-quickcheck == 0.8.*
73+
74+benchmark benchmark
75+ Type: exitcode-stdio-1.0
76+ Main-is: BenchUUID.hs
77+ Hs-source-dirs: tests
78+ Extensions: DeriveDataTypeable, CPP
79+ Ghc-Options: -Wall -fno-warn-orphans
80+ Build-depends: base == 4.*,
81+ uuid,
82+ criterion >= 0.4 && < 1.2,
83+ mersenne-random-pure64,
84+ random >= 1.0.1 && < 1.2