on 873f25d help sign in
36 files changed+546−1025
since splitsnapshots
unifiedsplit
.git-blame-ignore-revs−2 .github/workflows/haskell-ci-bench.yml−241 .github/workflows/haskell-ci.yml−262 .gitignore+1−2 .travis.yml+77 cabal.bench.project−4 cabal.haskell-ci−7 cabal.project+4−2 gen-ci.sh−5 uuid-bench/LICENSE−28 uuid-bench/src-uuid−1 uuid-bench/src-uuid-types−1 uuid-bench/uuid-bench.cabal−126 uuid-types/CHANGES+21 uuid-types/ChangeLog.md−31 uuid-types/src/Data/UUID/Types.hs → uuid-types/Data/UUID/Types.hs+5−11 uuid-types/src/Data/UUID/Types/Internal.hs → uuid-types/Data/UUID/Types/Internal.hs+73−71 uuid-types/src/Data/UUID/Types/Internal/Builder.hs → uuid-types/Data/UUID/Types/Internal/Builder.hs+1−3 uuid-types/cabal.project−1 uuid-bench/bench/uuid-types-benchmark.hs → uuid-types/tests/BenchUUID.hs uuid-types/tests/TestUUID.hs+4−36 uuid-types/tests/summarize-bench-results.pl+14 uuid-types/uuid-types.cabal+71−77 uuid/CHANGES.md+1−15 uuid/src/Data/UUID.hs → uuid/Data/UUID.hs+3−2 uuid/src/Data/UUID/Named.hs → uuid/Data/UUID/Named.hs 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+1−1 uuid/src/Data/UUID/V4.hs → uuid/Data/UUID/V4.hs+8−6 uuid/src/Data/UUID/V5.hs → uuid/Data/UUID/V5.hs uuid/src/Data/Word/Util.hs → uuid/Data/Word/Util.hs uuid-bench/bench/uuid-benchmark.hs → uuid/tests/BenchUUID.hs+1 uuid/tests/TestUUID.hs+21−5 uuid/tests/summarize-bench-results.pl+14 uuid/uuid.cabal+80−85
.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+1−2
@@ -5,9 +5,8 @@ cabal.sandbox.config
55# Cabal stuff
66dist/
77cabal.config
8−dist-newstyle/
8+/dist-newstyle/
99/cabal.project.local
10−.ghc.environment.*
1110
1211# Emacs
1312*~
.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 @@
22-- for more details
33
44packages: uuid-types/
5−packages: uuid/
5+ uuid/
66
77package uuid-types
88 tests: True
9+ benchmarks: True
910 -- profiling: True
1011 -- profiling-detail: toplevel-functions
1112
1213package uuid
1314 tests: True
15+ benchmarks: True
1416 -- 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 @@
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+21
@@ -0,0 +1,21 @@
1+1.0.4
2+
3+- Use more compact heap object representation
4+ which saves 16 bytes on 64bit platforms.
5+- Add toWords64/fromWords64
6+
7+1.0.3
8+
9+- Bump package dependencies
10+
11+1.0.2
12+
13+- Add toText/fromText
14+
15+1.0.1
16+
17+- Update dependencies in tests and benchmarks.
18+
19+1.0.0
20+
21+- 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/src/Data/UUID/Types.hs → uuid-types/Data/UUID/Types.hsrenamed+5−11
@@ -1,5 +1,3 @@
1−{-# LANGUAGE Trustworthy #-}
2−
31{- |
42Module : Data.UUID.Types
53Copyright : (c) 2017-2018 Herbert Valerio Riedel
@@ -11,17 +9,13 @@ Maintainer : hvr@gnu.org
119Portability : portable
1210
1311This library is useful for comparing, parsing and
14−printing <http://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)>.
12+printing Universally Unique Identifiers.
13+See <http://en.wikipedia.org/wiki/UUID> for the general idea.
1514See <http://tools.ietf.org/html/rfc4122 RFC 4122> for the specification.
1615
1716-}
1817module Data.UUID.Types
19− ( -- * The 'UUID' Type
20− UUID
21− -- * Nil UUID
22− , nil
23− , null
24− -- * Textual Representation
18+ ( UUID
2519 , toString
2620 , fromString
2721 , toText
@@ -30,14 +24,14 @@ module Data.UUID.Types
3024 , fromASCIIBytes
3125 , toLazyASCIIBytes
3226 , fromLazyASCIIBytes
33− -- * Binary Representation
3427 , toByteString
3528 , fromByteString
36− -- * Integer Representation
3729 , toWords
3830 , fromWords
3931 , toWords64
4032 , fromWords64
33+ , null
34+ , nil
4135 ) where
4236
4337import Data.UUID.Types.Internal
uuid-types/src/Data/UUID/Types/Internal.hs → uuid-types/Data/UUID/Types/Internal.hsrenamed+73−71
@@ -2,9 +2,6 @@
22{-# LANGUAGE DeriveDataTypeable #-}
33{-# LANGUAGE TypeFamilies #-}
44{-# LANGUAGE ViewPatterns #-}
5−{-# LANGUAGE Unsafe #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE StandaloneDeriving #-}
85{-# OPTIONS_HADDOCK hide #-}
96
107-- |
@@ -46,11 +43,13 @@ module Data.UUID.Types.Internal
4643
4744import Prelude hiding (null)
4845
46+import Control.Applicative ((<*>))
4947import Control.DeepSeq (NFData (..))
5048import Control.Monad (guard, liftM2)
5149import Data.Bits
5250import Data.Char
5351import Data.Data
52+import Data.Functor ((<$>))
5453import Data.Hashable
5554import Data.List (elemIndices)
5655import Foreign.Ptr (Ptr)
@@ -65,19 +64,19 @@ import qualified Data.ByteString.Internal as BI
6564import qualified Data.ByteString.Lazy as BL
6665import qualified Data.ByteString.Unsafe as BU
6766import Data.Text (Text)
68−import qualified Data.Text.Encoding as T
67+import qualified Data.Text as T
6968
7069import Data.UUID.Types.Internal.Builder
7170
72−import System.Random (Random (..), uniform)
73−import System.Random.Stateful (Uniform (..), uniformWord64)
71+import System.Random
7472
75−import Language.Haskell.TH.Syntax (Lift)
7673
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>.
74+-- |The UUID type. A 'Random' instance is provided which produces
75+-- insecure version 4 UUIDs as specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>. The 'Storable' and
76+-- 'Binary' instances are compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in
77+-- network order as 16 bytes.
7978data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
80− deriving (Eq, Ord)
79+ deriving (Eq, Ord, Typeable)
8180{-
8281 Prior to uuid-types-1.0.4:
8382 !Word32 !Word32 !Word32 !Word32
@@ -96,9 +95,6 @@ data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
9695-- Useful for when you need to serialize a UUID and
9796-- neither 'Storable' nor 'Binary' are appropriate.
9897--
99−-- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000"
100−-- Just (1427014656,3801825748,2803254374,1430519808)
101−--
10298-- See also 'toWords64'.
10399--
104100-- /Since: @uuid-1.2.2@/
@@ -126,9 +122,6 @@ fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
126122
127123-- | Convert a 'UUID' into a pair of 'Word64's.
128124--
129−-- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000"
130−-- Just (6128981282234515924,12039885860129472512)
131−--
132125-- See also 'toWords'.
133126--
134127-- @since 1.0.4
@@ -195,10 +188,10 @@ pack unpacked =
195188
196189-- |Build a Word32 from four Word8 values, presented in big-endian order
197190word :: 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 )
191+word a b c d = (fromIntegral a `shiftL` 24)
192+ .|. (fromIntegral b `shiftL` 16)
193+ .|. (fromIntegral c `shiftL` 8)
194+ .|. (fromIntegral d )
202195
203196-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
204197byte :: Int -> Word64 -> Word8
@@ -207,7 +200,7 @@ byte i w = fromIntegral (w `shiftR` (i * 8))
207200-- |Build a Word16 from two Word8 values, presented in big-endian order.
208201w8to16 :: Word8 -> Word8 -> Word16
209202w8to16 w0s w1s =
210− (w0 `unsafeShiftL` 8) .|. w1
203+ (w0 `shiftL` 8) .|. w1
211204 where
212205 w0 = fromIntegral w0s
213206 w1 = fromIntegral w1s
@@ -241,7 +234,7 @@ buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
241234 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
242235 b8' = b8 .&. 0x3f .|. 0x80
243236
244−-- |Build a UUID of a given version from 'Word32' values.
237+-- |Build a UUID of a given version from Word32 values.
245238buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
246239buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3
247240 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
@@ -275,8 +268,8 @@ null = (== nil)
275268 -- null (UUID 0 0 0 0) = True
276269 -- null _ = False
277270
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'@.
271+-- |The nil UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
272+-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
280273nil :: UUID
281274nil = UUID 0 0
282275
@@ -286,8 +279,6 @@ fromByteString :: BL.ByteString -> Maybe UUID
286279fromByteString = fromList . BL.unpack
287280
288281-- |Encode a UUID into a 'ByteString' in network order.
289−--
290−-- This uses the same encoding as the 'Binary' instance.
291282toByteString :: UUID -> BL.ByteString
292283toByteString = BL.pack . toList
293284
@@ -295,8 +286,9 @@ toByteString = BL.pack . toList
295286-- The hyphens may not be omitted.
296287-- Example:
297288--
298−-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"
299−-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c
289+-- @
290+-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
291+-- @
300292--
301293-- Hex digits may be upper or lower-case.
302294fromString :: String -> Maybe UUID
@@ -328,39 +320,32 @@ fromString' s0 = do
328320-- | Convert a UUID into a hypenated string using lower-case letters.
329321-- Example:
330322--
331−-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
332−-- Just "550e8400-e29b-41d4-a716-446655440000"
333−--
334−--
323+-- @
324+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
325+-- @
335326toString :: 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
327+toString uuid = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
328+ where hexw :: Word32 -> String -> String
329+ hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
330+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
331+
332+ hexw' :: Word32 -> String -> String
333+ hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
334+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
335+
336+ hexn :: Word32 -> Int -> Char
352337 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
353338
354− (w0,w1) = toWords64 uuid
339+ (w0,w1,w2,w3) = toWords uuid
355340
356341-- | If the passed in `Text` can be parsed as an ASCII representation of
357342-- a `UUID`, it will be. The hyphens may not be omitted.
358343fromText :: Text -> Maybe UUID
359−fromText = fromASCIIBytes . T.encodeUtf8
344+fromText = fromString . T.unpack
360345
361346-- | Convert a UUID into a hyphentated string using lower-case letters.
362347toText :: UUID -> Text
363−toText = T.decodeLatin1 . toASCIIBytes
348+toText = T.pack . toString
364349
365350-- | Convert a UUID into a hyphentated string using lower-case letters, packed
366351-- as ASCII bytes into `B.ByteString`.
@@ -455,30 +440,49 @@ fromASCIIBytes bs = do
455440-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
456441toLazyASCIIBytes :: UUID -> BL.ByteString
457442toLazyASCIIBytes =
443+#if MIN_VERSION_bytestring(0,10,0)
458444 BL.fromStrict
445+#else
446+ BL.fromChunks . return
447+#endif
459448 . toASCIIBytes
460449
461450-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
462451fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
463452fromLazyASCIIBytes bs =
464− if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
453+ if BL.length bs == 36 then fromASCIIBytes (
454+#if MIN_VERSION_bytestring(0,10,0)
455+ BL.toStrict bs
456+#else
457+ B.concat $ BL.toChunks bs
458+#endif
459+ ) else Nothing
465460
466461--
467462-- Class Instances
468463--
469464
470−-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471−-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
472465instance Random UUID where
473− random = uniform
466+ random g = (fromGenNext w0 w1 w2 w3 w4, g4)
467+ where (w0, g0) = next g
468+ (w1, g1) = next g0
469+ (w2, g2) = next g1
470+ (w3, g3) = next g2
471+ (w4, g4) = next g3
474472 randomR _ = random -- range is ignored
475473
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
474+-- |Build a UUID from the results of five calls to next on a StdGen.
475+-- While next on StdGet returns an Int, it doesn't provide 32 bits of
476+-- randomness. This code relies on at last 28 bits of randomness in the
477+-- and optimizes its use so as to make only five random values, not six.
478+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
479+fromGenNext w0 w1 w2 w3 w4 =
480+ buildFromBytes 4 /-/ (ThreeByte w0)
481+ /-/ (ThreeByte w1)
482+ /-/ w2 -- use all 4 bytes because we know the version
483+ -- field will "cover" the upper, non-random bits
484+ /-/ (ThreeByte w3)
485+ /-/ (ThreeByte w4)
482486
483487-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
484488-- only returns 31 bits of randomness.
@@ -486,8 +490,8 @@ type instance ByteSink ThreeByte g = Takes3Bytes g
486490newtype ThreeByte = ThreeByte Int
487491instance ByteSource ThreeByte where
488492 f /-/ (ThreeByte w) = f b1 b2 b3
489− where b1 = fromIntegral (w `unsafeShiftR` 16)
490− b2 = fromIntegral (w `unsafeShiftR` 8)
493+ where b1 = fromIntegral (w `shiftR` 16)
494+ b2 = fromIntegral (w `shiftR` 8)
491495 b3 = fromIntegral w
492496
493497instance NFData UUID where
@@ -504,11 +508,6 @@ instance Hashable UUID where
504508 `hashWithSalt` w2
505509 `hashWithSalt` w3
506510
507−-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
508−--
509−-- >>> show nil
510−-- "00000000-0000-0000-0000-000000000000"
511−--
512511instance Show UUID where
513512 show = toString
514513
@@ -519,7 +518,7 @@ instance Read UUID where
519518 Nothing -> []
520519 Just u -> [(u,drop 36 noSpaces)]
521520
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__.
521+
523522instance Storable UUID where
524523 sizeOf _ = 16
525524 alignment _ = 4
@@ -556,7 +555,6 @@ instance Storable UUID where
556555 pokeByteOff p (off+14) x9
557556 pokeByteOff p (off+15) x10
558557
559−-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.
560558instance Binary UUID where
561559 put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
562560 get = liftM2 UUID getWord64be getWord64be
@@ -572,4 +570,8 @@ instance Data UUID where
572570uuidType :: DataType
573571uuidType = mkNoRepType "Data.UUID.Types.UUID"
574572
575−deriving instance Lift UUID
573+#if !MIN_VERSION_base(4,5,0)
574+unsafeShiftR, unsafeShiftL :: Word64 -> Int -> Word64
575+unsafeShiftR = shiftR
576+unsafeShiftL = shiftL
577+#endif
uuid-types/src/Data/UUID/Types/Internal/Builder.hs → uuid-types/Data/UUID/Types/Internal/Builder.hsrenamed+1−3
@@ -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
uuid-types/cabal.projectdeleted−1
@@ -1 +0,0 @@
1−packages: .
uuid-bench/bench/uuid-types-benchmark.hs → uuid-types/tests/BenchUUID.hsrenamed

The content is the same.

uuid-types/tests/TestUUID.hs+4−36
@@ -1,9 +1,7 @@
11{-# LANGUAGE ViewPatterns #-}
2−{-# LANGUAGE TemplateHaskell #-}
32
43{-# OPTIONS_GHC -fno-warn-orphans #-}
54
6−import Data.Binary (encode)
75import qualified Data.ByteString.Char8 as BC8
86import qualified Data.ByteString.Lazy as BL
97import qualified Data.ByteString.Lazy.Char8 as BL8
@@ -11,9 +9,7 @@ import Data.Char (ord)
119import Data.Functor ((<$>))
1210import qualified Data.UUID.Types as U
1311import Data.Word
14−import Foreign (alloca, castPtr, peek, poke,
15− sizeOf)
16−import GHC.ByteOrder (ByteOrder(..), targetByteOrder)
12+import Foreign (alloca, peek, poke)
1713import System.IO.Unsafe (unsafePerformIO)
1814
1915import Test.QuickCheck (Arbitrary (arbitrary), choose)
@@ -22,7 +18,6 @@ import Test.Tasty (TestTree, defaultMain, testGroup)
2218import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))
2319import Test.Tasty.QuickCheck (testProperty)
2420
25−
2621-- orphan
2722instance Arbitrary U.UUID where
2823 -- the UUID random instance ignores bounds
@@ -41,11 +36,6 @@ test_nil = testGroup "nil" [
4136 testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)
4237 ]
4338
44−test_lift :: Test
45−test_lift = testCase "TH.Lift" $ do
46− let uuid = U.fromWords64 123456789 987654321
47− uuid @?= $( [| uuid |] )
48−
4939test_conv :: Test
5040test_conv = testGroup "conversions" [
5141 testCase "conv bytes to string" $
@@ -61,32 +51,13 @@ test_fromByteString :: Test
6151test_fromByteString =
6252 testCase "UUID fromByteString" $
6353 Just inputUUID @=?
64− U.fromByteString (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2")
54+ U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")
6555
6656-- | Test fromWords with a fixed-input
6757test_fromWords :: Test
6858test_fromWords =
6959 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
60+ inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594
9061
9162inputUUID :: U.UUID
9263inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
@@ -182,12 +153,9 @@ main = do
182153 [ [
183154 test_null,
184155 test_nil,
185− test_lift,
186156 test_conv,
187157 test_fromByteString,
188− test_fromWords,
189− test_Storeable,
190− test_Binary
158+ test_fromWords
191159 ]
192160 , [ prop_stringRoundTrip,
193161 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+71−77
@@ -1,30 +1,18 @@
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+cabal-version: 1.12
2+name: uuid-types
3+version: 1.0.4
84
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
5+copyright: (c) 2017-2018 Herbert Valerio Riedel
6+ (c) 2008-2014 Antoine Latter
7+author: Antoine Latter
8+maintainer: hvr@gnu.org
9+license: BSD3
10+license-file: LICENSE
11+category: Data
12+build-type: Simple
13+tested-with: GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2
2614
27−synopsis: Type definitions for Universally Unique Identifiers
15+synopsis: Type definitions for Universally Unique Identifiers
2816description:
2917 This library contains type definitions for
3018 <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)>
@@ -35,65 +23,71 @@ description:
3523 See also the <https://hackage.haskell.org/package/uuid 'uuid' package>
3624 providing a high-level API for managing the different UUID versions.
3725
38−homepage: https://github.com/haskell-hvr/uuid
39−bug-reports: https://github.com/haskell-hvr/uuid/issues
40−extra-source-files: ChangeLog.md
26+homepage: https://github.com/hvr/uuid
27+bug-reports: https://github.com/hvr/uuid/issues
4128
42−source-repository head
43− type: git
44− location: https://github.com/haskell-hvr/uuid.git
45− subdir: uuid-types
46−
47−library
48− build-depends:
49− base >=4.12.0.0 && <5
50− , binary >=0.8.6.0 && <0.9
51− , bytestring >=0.10.8.2 && <0.13
52− , deepseq >=1.4.4.0 && <1.6
53− , hashable >=1.4.4.0 && <1.6
54− , random >=1.2.1.2 && <1.3
55− , template-haskell >=2.14.0.0 && <2.24
56− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
29+extra-source-files:
30+ CHANGES
5731
58− exposed-modules: Data.UUID.Types
32+source-repository head
33+ type: git
34+ location: https://github.com/hvr/uuid.git
35+ subdir: uuid-types
5936
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
37+Library
38+ build-depends: base >= 4.3 && < 5
39+ , binary >= 0.4 && < 0.9
40+ , bytestring >= 0.9 && < 0.11
41+ , deepseq >= 1.3 && < 1.5
42+ , hashable (>= 1.1.1.0 && < 1.2)
43+ || (>= 1.2.1 && < 1.3)
44+ , random >= 1.0.1 && < 1.2
45+ , text >= 1 && < 1.3
6446
65− default-language: Haskell2010
66− other-extensions:
67− DeriveDataTypeable
68− TypeFamilies
47+ exposed-modules:
48+ Data.UUID.Types
49+ -- Exposed for companion projects; *NOT* part of the official API:
50+ Data.UUID.Types.Internal.Builder
51+ Data.UUID.Types.Internal
6952
70− ghc-options: -Wall
71− hs-source-dirs: src
53+ default-language: Haskell2010
54+ other-extensions: TypeFamilies
55+ DeriveDataTypeable
56+ ghc-options: -Wall
7257
7358test-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
59+ type: exitcode-stdio-1.0
60+ main-is: TestUUID.hs
61+ hs-source-dirs: tests
62+ default-language: Haskell2010
63+ other-extensions: ViewPatterns
64+ ghc-options: -Wall
8265
83− -- inherited constraints
84− build-depends:
85− base
86− , binary
87− , bytestring
88− , template-haskell
89− , uuid-types
66+ build-depends: uuid-types
67+ -- inherited constraints
68+ , base
69+ , bytestring
70+ -- deps w/o inherited constraints
71+ , HUnit >= 1.2 && < 1.4
72+ , QuickCheck >= 2.4 && < 2.10
73+ , tasty >= 0.10 && < 0.12
74+ , tasty-hunit == 0.9.*
75+ , tasty-quickcheck == 0.8.*
9076
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
77+benchmark benchmark
78+ type: exitcode-stdio-1.0
79+ main-is: BenchUUID.hs
80+ hs-source-dirs: tests
81+ default-language: Haskell2010
82+ other-extensions: CPP
83+ ghc-options: -Wall
9784
98− if !impl(ghc >=8.4)
99− build-depends: ghc-byteorder >=4.11 && <4.12
85+ build-depends: uuid-types
86+ -- inherited constraints
87+ , base
88+ , bytestring
89+ , random
90+ -- deps w/o inherited constraints
91+ , containers >= 0.4 && < 0.6
92+ , criterion >= 0.4 && < 1.2
93+ , unordered-containers >= 0.2.7 && < 0.3
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−
1411.3.13
152
163- Optimize `V4.nextRandom` (~3x speed increase)
174- Optimize UUID V3 & V5 generation (~2x speed increase)
185- Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead
19− of `memory`/`cryptonite` for better performance and stability,
20− but GHCJS is now no longer supported.
6+ of `memory`/`cryptonite` for better performance and stability.
217- Update cabal-spec to version 1.10
228
2391.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.
1818favorite instance of 'System.Random.Random' for faster but insecure
1919generation of UUIDs.
2020
21+* We have an implementation of generating a UUID from the hardware
22+MAC address and current system time in "Data.UUID.V1".
23+
2124* For name-based generation of UUIDs using SHA-1 hashing see
2225"Data.UUID.V5".
2326-}
@@ -34,8 +37,6 @@ module Data.UUID(UUID
3437 ,fromByteString
3538 ,toWords
3639 ,fromWords
37− ,toWords64
38− ,fromWords64
3940 ,null
4041 ,nil
4142 ) 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 (
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+1−1
@@ -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
uuid/src/Data/UUID/V4.hs → uuid/Data/UUID/V4.hsrenamed+8−6
@@ -11,9 +11,12 @@
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
@@ -23,9 +26,8 @@ import Data.UUID.Types.Internal ( buildFromBytes )
2326import System.Entropy ( getEntropy )
2427import Data.ByteString ( unpack )
2528
26−-- | Generate a crytographically secure, random UUID.
27−--
28−-- @since 1.2.6
29+-- | Generate a crytographically secure, random UUID. Introduced in version
30+-- 1.2.6.
2931nextRandom :: IO UUID
3032nextRandom = do
3133 [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)
33import Data.IORef
44import Data.Word
55import qualified Data.UUID as U
6+import qualified Data.UUID.V1 as U
67import qualified Data.UUID.V4 as U
78import qualified Data.UUID.V3 as U3
89import 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+80−85
@@ -1,95 +1,90 @@
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.13
3+Copyright: (c) 2008-2014 Antoine Latter
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.10
11+Tested-With: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2
2312
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.
2619
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.
20+Homepage: https://github.com/hvr/uuid
21+Bug-Reports: https://github.com/hvr/uuid/issues
3222
33−homepage: https://github.com/haskell-hvr/uuid
34−bug-reports: https://github.com/haskell-hvr/uuid/issues
35−extra-source-files: CHANGES.md
23+Extra-Source-Files:
24+ CHANGES.md
3625
37−source-repository head
38− type: git
39− location: https://github.com/haskell-hvr/uuid.git
40− subdir: uuid
26+Source-Repository head
27+ Type: git
28+ Location: https://github.com/hvr/uuid.git
29+ Subdir: uuid
4130
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
31+Library
32+ Build-Depends: base >= 4.3 && < 5,
33+ binary >= 0.4 && < 0.9,
34+ bytestring >= 0.10 && < 0.11,
35+ cryptohash-sha1 >= 0.11.100 && < 0.12,
36+ cryptohash-md5 >= 0.11.100 && < 0.12,
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
5043
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
44+ Exposed-Modules:
45+ Data.UUID
46+ Data.UUID.Util
47+ Data.UUID.V1
48+ Data.UUID.V3
49+ Data.UUID.V4
50+ Data.UUID.V5
6051
61− other-modules:
62− Data.UUID.Named
63− Data.Word.Util
52+ Other-Modules:
53+ Data.UUID.Named
54+ Data.Word.Util
6455
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
56+ Default-Language: Haskell2010
57+ Default-Extensions: DeriveDataTypeable
58+ Other-Extensions: TypeFamilies
59+ Ghc-Options: -Wall
7260
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
61+Test-Suite testuuid
62+ Type: exitcode-stdio-1.0
63+ Main-is: TestUUID.hs
64+ Hs-source-dirs: tests
65+ Default-Language: Haskell2010
66+ Default-Extensions: DeriveDataTypeable
67+ Other-Extensions: ViewPatterns
68+ Ghc-Options: -Wall -fno-warn-orphans
69+ Build-Depends: uuid
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.*
8378
84− -- inherited constraints
85− build-depends:
86− base
87− , bytestring
88− , uuid
89−
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
79+benchmark benchmark
80+ Type: exitcode-stdio-1.0
81+ Main-is: BenchUUID.hs
82+ Hs-source-dirs: tests
83+ Default-Language: Haskell2010
84+ Default-Extensions: DeriveDataTypeable, CPP
85+ Ghc-Options: -Wall -fno-warn-orphans
86+ Build-Depends: uuid
87+ Build-Depends: base >= 4.3 && < 5,
88+ criterion >= 0.4 && < 1.2,
89+ mersenne-random-pure64 >= 0.2 && < 0.3,
90+ random >= 1.0.1 && < 1.2