git.iko.soy/typeable/uuid
on 34a40da help sign in
49f50ae
swap
0 ahead, 72 behind
.git-blame-ignore-revsdeleted−2
since splitsnapshots
unifiedsplit
@@ -1,2 +0,0 @@
1−# Move code into subdirectories
2−bf1ac1bad848bb2c081f0cae1631bf53811ec05a
.github/workflows/haskell-ci-bench.ymldeleted−241
@@ -1,241 +0,0 @@
1−# This GitHub workflow config has been generated by a script via
2−#
3−# haskell-ci 'github' '--project' 'cabal.bench.project' '-o' '.github/workflows/haskell-ci-bench.yml' '--github-action-name' 'Benchmarks'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.19.20240702
12−#
13−# REGENDATA ("0.19.20240702",["github","--project","cabal.bench.project","-o",".github/workflows/haskell-ci-bench.yml","--github-action-name","Benchmarks"])
14−#
15−name: Benchmarks
16−on:
17− push:
18− branches:
19− - master
20− pull_request:
21− branches:
22− - master
23−jobs:
24− linux:
25− name: Benchmarks - Linux - ${{ matrix.compiler }}
26− runs-on: ubuntu-20.04
27− timeout-minutes:
28− 60
29− container:
30− image: buildpack-deps:jammy
31− continue-on-error: ${{ matrix.allow-failure }}
32− strategy:
33− matrix:
34− include:
35− - compiler: ghc-9.10.1
36− compilerKind: ghc
37− compilerVersion: 9.10.1
38− setup-method: ghcup
39− allow-failure: false
40− - compiler: ghc-9.8.2
41− compilerKind: ghc
42− compilerVersion: 9.8.2
43− setup-method: ghcup
44− allow-failure: false
45− - compiler: ghc-9.6.6
46− compilerKind: ghc
47− compilerVersion: 9.6.6
48− setup-method: ghcup
49− allow-failure: false
50− - compiler: ghc-9.4.8
51− compilerKind: ghc
52− compilerVersion: 9.4.8
53− setup-method: ghcup
54− allow-failure: false
55− - compiler: ghc-9.2.8
56− compilerKind: ghc
57− compilerVersion: 9.2.8
58− setup-method: ghcup
59− allow-failure: false
60− - compiler: ghc-9.0.2
61− compilerKind: ghc
62− compilerVersion: 9.0.2
63− setup-method: ghcup
64− allow-failure: false
65− - compiler: ghc-8.10.7
66− compilerKind: ghc
67− compilerVersion: 8.10.7
68− setup-method: ghcup
69− allow-failure: false
70− - compiler: ghc-8.8.4
71− compilerKind: ghc
72− compilerVersion: 8.8.4
73− setup-method: ghcup
74− allow-failure: false
75− - compiler: ghc-8.6.5
76− compilerKind: ghc
77− compilerVersion: 8.6.5
78− setup-method: ghcup
79− allow-failure: false
80− fail-fast: false
81− steps:
82− - name: apt
83− run: |
84− apt-get update
85− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
86− mkdir -p "$HOME/.ghcup/bin"
87− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
88− chmod a+x "$HOME/.ghcup/bin/ghcup"
89− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
90− "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
91− env:
92− HCKIND: ${{ matrix.compilerKind }}
93− HCNAME: ${{ matrix.compiler }}
94− HCVER: ${{ matrix.compilerVersion }}
95− - name: Set PATH and environment variables
96− run: |
97− echo "$HOME/.cabal/bin" >> $GITHUB_PATH
98− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
99− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
100− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
101− HCDIR=/opt/$HCKIND/$HCVER
102− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
103− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
104− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
105− echo "HC=$HC" >> "$GITHUB_ENV"
106− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
107− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
108− echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
109− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
110− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
111− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
112− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
113− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
114− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
115− echo "GHCJSARITH=0" >> "$GITHUB_ENV"
116− env:
117− HCKIND: ${{ matrix.compilerKind }}
118− HCNAME: ${{ matrix.compiler }}
119− HCVER: ${{ matrix.compilerVersion }}
120− - name: env
121− run: |
122− env
123− - name: write cabal config
124− run: |
125− mkdir -p $CABAL_DIR
126− cat >> $CABAL_CONFIG <<EOF
127− remote-build-reporting: anonymous
128− write-ghc-environment-files: never
129− remote-repo-cache: $CABAL_DIR/packages
130− logs-dir: $CABAL_DIR/logs
131− world-file: $CABAL_DIR/world
132− extra-prog-path: $CABAL_DIR/bin
133− symlink-bindir: $CABAL_DIR/bin
134− installdir: $CABAL_DIR/bin
135− build-summary: $CABAL_DIR/logs/build.log
136− store-dir: $CABAL_DIR/store
137− install-dirs user
138− prefix: $CABAL_DIR
139− repository hackage.haskell.org
140− url: http://hackage.haskell.org/
141− EOF
142− cat >> $CABAL_CONFIG <<EOF
143− program-default-options
144− ghc-options: $GHCJOBS +RTS -M3G -RTS
145− EOF
146− cat $CABAL_CONFIG
147− - name: versions
148− run: |
149− $HC --version || true
150− $HC --print-project-git-commit-id || true
151− $CABAL --version || true
152− - name: update cabal index
153− run: |
154− $CABAL v2-update -v
155− - name: install cabal-plan
156− run: |
157− mkdir -p $HOME/.cabal/bin
158− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
159− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
160− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
161− rm -f cabal-plan.xz
162− chmod a+x $HOME/.cabal/bin/cabal-plan
163− cabal-plan --version
164− - name: checkout
165− uses: actions/checkout@v4
166− with:
167− path: source
168− - name: initial cabal.project for sdist
169− run: |
170− touch cabal.project
171− echo "packages: $GITHUB_WORKSPACE/source/uuid-bench" >> cabal.project
172− cat cabal.project
173− - name: sdist
174− run: |
175− mkdir -p sdist
176− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
177− - name: unpack
178− run: |
179− mkdir -p unpacked
180− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
181− - name: generate cabal.project
182− run: |
183− PKGDIR_uuid_bench="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-bench-[0-9.]*')"
184− echo "PKGDIR_uuid_bench=${PKGDIR_uuid_bench}" >> "$GITHUB_ENV"
185− rm -f cabal.project cabal.project.local
186− touch cabal.project
187− touch cabal.project.local
188− echo "packages: ${PKGDIR_uuid_bench}" >> cabal.project
189− echo "package uuid-bench" >> cabal.project
190− echo " ghc-options: -Werror=missing-methods" >> cabal.project
191− cat >> cabal.project <<EOF
192− EOF
193− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(uuid-bench)$/; }' >> cabal.project.local
194− cat cabal.project
195− cat cabal.project.local
196− - name: dump install plan
197− run: |
198− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
199− cabal-plan
200− - name: restore cache
201− uses: actions/cache/restore@v4
202− with:
203− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
204− path: ~/.cabal/store
205− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
206− - name: install dependencies
207− run: |
208− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
209− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
210− - name: build w/o tests
211− run: |
212− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
213− - name: build
214− run: |
215− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
216− - name: cabal check
217− run: |
218− cd ${PKGDIR_uuid_bench} || false
219− ${CABAL} -vnormal check
220− - name: haddock
221− run: |
222− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
223− - name: unconstrained build
224− run: |
225− rm -f cabal.project.local
226− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
227− - name: prepare for constraint sets
228− run: |
229− rm -f cabal.project.local
230− - name: constraint set random-1.2
231− run: |
232− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all --dry-run
233− cabal-plan topo | sort
234− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' --dependencies-only -j2 all
235− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all
236− - name: save cache
237− uses: actions/cache/save@v4
238− if: always()
239− with:
240− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
241− path: ~/.cabal/store
.github/workflows/haskell-ci.ymldeleted−262
@@ -1,262 +0,0 @@
1−# This GitHub workflow config has been generated by a script via
2−#
3−# haskell-ci 'github' 'cabal.project'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.19.20241223
12−#
13−# REGENDATA ("0.19.20241223",["github","cabal.project"])
14−#
15−name: Haskell-CI
16−on:
17− push:
18− branches:
19− - master
20− pull_request:
21− branches:
22− - master
23−jobs:
24− linux:
25− name: Haskell-CI - Linux - ${{ matrix.compiler }}
26− runs-on: ubuntu-20.04
27− timeout-minutes:
28− 60
29− container:
30− image: buildpack-deps:jammy
31− continue-on-error: ${{ matrix.allow-failure }}
32− strategy:
33− matrix:
34− include:
35− - compiler: ghc-9.12.1
36− compilerKind: ghc
37− compilerVersion: 9.12.1
38− setup-method: ghcup
39− allow-failure: false
40− - compiler: ghc-9.10.1
41− compilerKind: ghc
42− compilerVersion: 9.10.1
43− setup-method: ghcup
44− allow-failure: false
45− - compiler: ghc-9.8.4
46− compilerKind: ghc
47− compilerVersion: 9.8.4
48− setup-method: ghcup
49− allow-failure: false
50− - compiler: ghc-9.6.6
51− compilerKind: ghc
52− compilerVersion: 9.6.6
53− setup-method: ghcup
54− allow-failure: false
55− - compiler: ghc-9.4.8
56− compilerKind: ghc
57− compilerVersion: 9.4.8
58− setup-method: ghcup
59− allow-failure: false
60− - compiler: ghc-9.2.8
61− compilerKind: ghc
62− compilerVersion: 9.2.8
63− setup-method: ghcup
64− allow-failure: false
65− - compiler: ghc-9.0.2
66− compilerKind: ghc
67− compilerVersion: 9.0.2
68− setup-method: ghcup
69− allow-failure: false
70− - compiler: ghc-8.10.7
71− compilerKind: ghc
72− compilerVersion: 8.10.7
73− setup-method: ghcup
74− allow-failure: false
75− - compiler: ghc-8.8.4
76− compilerKind: ghc
77− compilerVersion: 8.8.4
78− setup-method: ghcup
79− allow-failure: false
80− - compiler: ghc-8.6.5
81− compilerKind: ghc
82− compilerVersion: 8.6.5
83− setup-method: ghcup
84− allow-failure: false
85− fail-fast: false
86− steps:
87− - name: apt-get install
88− run: |
89− apt-get update
90− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
91− - name: Install GHCup
92− run: |
93− mkdir -p "$HOME/.ghcup/bin"
94− curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"
95− chmod a+x "$HOME/.ghcup/bin/ghcup"
96− - name: Install cabal-install
97− run: |
98− "$HOME/.ghcup/bin/ghcup" install cabal 3.14.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
99− echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
100− - name: Install GHC (GHCup)
101− if: matrix.setup-method == 'ghcup'
102− run: |
103− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
104− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
105− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
106− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
107− echo "HC=$HC" >> "$GITHUB_ENV"
108− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
109− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
110− env:
111− HCKIND: ${{ matrix.compilerKind }}
112− HCNAME: ${{ matrix.compiler }}
113− HCVER: ${{ matrix.compilerVersion }}
114− - name: Set PATH and environment variables
115− run: |
116− echo "$HOME/.cabal/bin" >> $GITHUB_PATH
117− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
118− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
119− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
120− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
121− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
122− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
123− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
124− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
125− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
126− env:
127− HCKIND: ${{ matrix.compilerKind }}
128− HCNAME: ${{ matrix.compiler }}
129− HCVER: ${{ matrix.compilerVersion }}
130− - name: env
131− run: |
132− env
133− - name: write cabal config
134− run: |
135− mkdir -p $CABAL_DIR
136− cat >> $CABAL_CONFIG <<EOF
137− remote-build-reporting: anonymous
138− write-ghc-environment-files: never
139− remote-repo-cache: $CABAL_DIR/packages
140− logs-dir: $CABAL_DIR/logs
141− world-file: $CABAL_DIR/world
142− extra-prog-path: $CABAL_DIR/bin
143− symlink-bindir: $CABAL_DIR/bin
144− installdir: $CABAL_DIR/bin
145− build-summary: $CABAL_DIR/logs/build.log
146− store-dir: $CABAL_DIR/store
147− install-dirs user
148− prefix: $CABAL_DIR
149− repository hackage.haskell.org
150− url: http://hackage.haskell.org/
151− EOF
152− cat >> $CABAL_CONFIG <<EOF
153− program-default-options
154− ghc-options: $GHCJOBS +RTS -M3G -RTS
155− EOF
156− cat $CABAL_CONFIG
157− - name: versions
158− run: |
159− $HC --version || true
160− $HC --print-project-git-commit-id || true
161− $CABAL --version || true
162− - name: update cabal index
163− run: |
164− $CABAL v2-update -v
165− - name: install cabal-plan
166− run: |
167− mkdir -p $HOME/.cabal/bin
168− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
169− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
170− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
171− rm -f cabal-plan.xz
172− chmod a+x $HOME/.cabal/bin/cabal-plan
173− cabal-plan --version
174− - name: checkout
175− uses: actions/checkout@v4
176− with:
177− path: source
178− - name: initial cabal.project for sdist
179− run: |
180− touch cabal.project
181− echo "packages: $GITHUB_WORKSPACE/source/uuid-types" >> cabal.project
182− echo "packages: $GITHUB_WORKSPACE/source/uuid" >> cabal.project
183− cat cabal.project
184− - name: sdist
185− run: |
186− mkdir -p sdist
187− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
188− - name: unpack
189− run: |
190− mkdir -p unpacked
191− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
192− - name: generate cabal.project
193− run: |
194− PKGDIR_uuid_types="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-types-[0-9.]*')"
195− echo "PKGDIR_uuid_types=${PKGDIR_uuid_types}" >> "$GITHUB_ENV"
196− PKGDIR_uuid="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/uuid-[0-9.]*')"
197− echo "PKGDIR_uuid=${PKGDIR_uuid}" >> "$GITHUB_ENV"
198− rm -f cabal.project cabal.project.local
199− touch cabal.project
200− touch cabal.project.local
201− echo "packages: ${PKGDIR_uuid_types}" >> cabal.project
202− echo "packages: ${PKGDIR_uuid}" >> cabal.project
203− echo "package uuid-types" >> cabal.project
204− echo " ghc-options: -Werror=missing-methods" >> cabal.project
205− echo "package uuid" >> cabal.project
206− echo " ghc-options: -Werror=missing-methods" >> cabal.project
207− cat >> cabal.project <<EOF
208− EOF
209− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(uuid|uuid-types)$/; }' >> cabal.project.local
210− cat cabal.project
211− cat cabal.project.local
212− - name: dump install plan
213− run: |
214− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
215− cabal-plan
216− - name: restore cache
217− uses: actions/cache/restore@v4
218− with:
219− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
220− path: ~/.cabal/store
221− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
222− - name: install dependencies
223− run: |
224− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
225− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
226− - name: build w/o tests
227− run: |
228− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
229− - name: build
230− run: |
231− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
232− - name: tests
233− run: |
234− $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
235− - name: cabal check
236− run: |
237− cd ${PKGDIR_uuid_types} || false
238− ${CABAL} -vnormal check
239− cd ${PKGDIR_uuid} || false
240− ${CABAL} -vnormal check
241− - name: haddock
242− run: |
243− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
244− - name: unconstrained build
245− run: |
246− rm -f cabal.project.local
247− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
248− - name: prepare for constraint sets
249− run: |
250− rm -f cabal.project.local
251− - name: constraint set random-1.2
252− run: |
253− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all --dry-run
254− cabal-plan topo | sort
255− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' --dependencies-only -j2 all
256− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='random==1.2.*' all
257− - name: save cache
258− if: always()
259− uses: actions/cache/save@v4
260− with:
261− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
262− path: ~/.cabal/store
.gitignore+1−2
@@ -5,9 +5,8 @@ cabal.sandbox.config
5# Cabal stuff
5# Cabal stuff
6dist/
6dist/
7cabal.config
7cabal.config
8−dist-newstyle/
8+/dist-newstyle/
9/cabal.project.local
9/cabal.project.local
10−.ghc.environment.*
11
10
12# Emacs
11# Emacs
13*~
12*~
.travis.ymlnew file+77
@@ -0,0 +1,77 @@
1+# This Travis job script has been generated by a script via
2+#
3+# make_travis_yml_2.hs 'uuid-types.cabal'
4+#
5+# For more information, see https://github.com/hvr/multi-ghc-travis
6+#
7+language: c
8+sudo: false
9+dist: trusty
10+
11+git:
12+ submodules: false # whether to recursively clone submodules
13+
14+cache:
15+ directories:
16+ - $HOME/.cabal/packages
17+ - $HOME/.cabal/store
18+
19+before_cache:
20+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
21+ # remove files that are regenerated by 'cabal update'
22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
24+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
27+
28+matrix:
29+ include:
30+ # - compiler: "ghc-7.0.4"
31+ # # env: TEST=--disable-tests BENCH=--disable-benchmarks
32+ # addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.0.4], sources: [hvr-ghc]}}
33+ - compiler: "ghc-7.4.2"
34+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
35+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.4.2], sources: [hvr-ghc]}}
36+ - compiler: "ghc-7.6.3"
37+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.6.3], sources: [hvr-ghc]}}
39+ - compiler: "ghc-7.8.4"
40+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
41+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}
42+ - compiler: "ghc-7.10.3"
43+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
44+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
45+ - compiler: "ghc-8.0.2"
46+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
47+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
48+
49+before_install:
50+ - HC=${CC}
51+ - unset CC
52+ - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
53+
54+install:
55+ - cabal --version
56+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
57+ - travis_retry cabal update -v
58+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
59+
60+ - cabal new-build -w ${HC} --dep -j2 all
61+
62+# Here starts the actual work to be performed for the package under test;
63+# any command which exits with a non-zero exit code causes the build to fail.
64+script:
65+ - cd uuid-types/
66+ - cabal sdist
67+ - cabal new-build -w ${HC} -j1
68+ - cabal new-test -w ${HC}
69+ - cd ..
70+
71+ - cd uuid/
72+ - cabal sdist
73+ - cabal new-build -w ${HC} -j1
74+ - cabal new-test -w ${HC}
75+ - cd ..
76+
77+# EOF
cabal.bench.projectdeleted−4
@@ -1,4 +0,0 @@
1−-- separate package for benchmarks
2−-- this way we can build criterion
3−packages: uuid-bench
4−benchmarks: True
cabal.haskell-cideleted−7
@@ -1,7 +0,0 @@
1−branches: master
2−-- jobs-selection: any
3−head-hackage: False
4−
5−constraint-set random-1.2
6− ghc: >=7.10
7− constraints: random==1.2.*
cabal.project+4−2
@@ -2,14 +2,16 @@
2-- for more details
2-- for more details
3
3
4packages: uuid-types/
4packages: uuid-types/
5−packages: uuid/
5+ uuid/
6
6
7package uuid-types
7package uuid-types
8 tests: True
8 tests: True
9+ benchmarks: True
9 -- profiling: True
10 -- profiling: True
10 -- profiling-detail: toplevel-functions
11 -- profiling-detail: toplevel-functions
11
12
12package uuid
13package uuid
13 tests: True
14 tests: True
15+ benchmarks: True
14 -- profiling: True
16 -- profiling: True
15− -- profiling-detail: toplevel-functions
17+ -- profiling-detail: toplevel-functions
gen-ci.shdeleted−5
@@ -1,5 +0,0 @@
1−#!/bin/sh
2−
3−# haskell-ci doesn't know how to regenerate multiple GHA workflows
4−haskell-ci github cabal.project
5−haskell-ci github --project cabal.bench.project -o .github/workflows/haskell-ci-bench.yml --github-action-name Benchmarks
uuid-bench/LICENSEdeleted−28
@@ -1,28 +0,0 @@
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+152−168
@@ -1,83 +1,85 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
1+{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP, ViewPatterns #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE ViewPatterns #-}
5−{-# LANGUAGE Unsafe #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE StandaloneDeriving #-}
8{-# OPTIONS_HADDOCK hide #-}
2{-# OPTIONS_HADDOCK hide #-}
9
3
10-- |
4-- |
11-- Module : Data.UUID.Types.Internal
5-- 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
14-- (c) 2009 Mark Lentczner
7-- (c) 2009 Mark Lentczner
15--
8--
16-- License : BSD-style
9-- License : BSD-style
17--
10--
18−-- Maintainer : hvr@gnu.org
11+-- Maintainer : aslatter@gmail.com
12+-- Stability : experimental
19-- Portability : portable
13-- Portability : portable
20
14
21module Data.UUID.Types.Internal
15module Data.UUID.Types.Internal
22− ( UUID(..)
16+ (UUID(..)
23− , null
17+ ,null
24− , nil
18+ ,nil
25− , fromByteString
19+ ,fromByteString
26− , toByteString
20+ ,toByteString
27− , fromString
21+ ,fromString
28− , toString
22+ ,toString
29− , fromText
23+ ,fromText
30− , toText
24+ ,toText
31− , fromWords
25+ ,fromWords
32− , toWords
26+ ,toWords
33− , fromWords64
34− , toWords64
35− , toList
27+ ,toList
36− , buildFromBytes
28+ ,buildFromBytes
37− , buildFromWords
29+ ,buildFromWords
38− , fromASCIIBytes
30+ ,fromASCIIBytes
39− , toASCIIBytes
31+ ,toASCIIBytes
40− , fromLazyASCIIBytes
32+ ,fromLazyASCIIBytes
41− , toLazyASCIIBytes
33+ ,toLazyASCIIBytes
42− , UnpackedUUID(..)
34+ ,UnpackedUUID(..)
43− , pack
35+ ,pack
44− , unpack
36+ ,unpack
45 ) where
37 ) where
46
38
47−import Prelude hiding (null)
39+import Prelude hiding (null)
48−
40+
41+import Control.Applicative ((<*>))
49−import Control.DeepSeq (NFData (..))
42+import Control.DeepSeq (NFData(..))
50−import Control.Monad (guard, liftM2)
43+import Control.Monad (liftM2, guard)
44+import Data.Functor ((<$>))
45+import Data.Char
51−import Data.Bits
46+import Data.Bits
52−import Data.Char
53−import Data.Data
54−import Data.Hashable
47+import Data.Hashable
55−import Data.List (elemIndices)
48+import Data.List (elemIndices)
56−import Foreign.Ptr (Ptr)
49+import Foreign.Ptr (Ptr)
57−
50+
51+#if MIN_VERSION_base(4,0,0)
52+import Data.Data
53+#else
54+import Data.Generics.Basics
55+#endif
56+
58−import Foreign.Storable
57+import Foreign.Storable
59−
58+
59+import Data.Binary
60−import Data.Binary
60+import Data.Binary.Put
61−import Data.Binary.Get
61+import Data.Binary.Get
62−import Data.Binary.Put
63−import qualified Data.ByteString as B
62+import qualified Data.ByteString as B
64−import qualified Data.ByteString.Internal as BI
63+import qualified Data.ByteString.Internal as BI
65−import qualified Data.ByteString.Lazy as BL
64+import qualified Data.ByteString.Lazy as BL
66−import qualified Data.ByteString.Unsafe as BU
65+import qualified Data.ByteString.Unsafe as BU
67−import Data.Text (Text)
66+import Data.Text (Text)
68−import qualified Data.Text.Encoding as T
67+import qualified Data.Text as T
69−
68+
70−import Data.UUID.Types.Internal.Builder
69+import Data.UUID.Types.Internal.Builder
71−
70+
72−import System.Random (Random (..), uniform)
71+import System.Random
73−import System.Random.Stateful (Uniform (..), uniformWord64)
72+
74−
73+
75−import Language.Haskell.TH.Syntax (Lift)
74+-- |The UUID type. A 'Random' instance is provided which produces
76−
75+-- insecure version 4 UUIDs as specified in RFC 4122. The 'Storable' and
77−-- | Type representing <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)> as specified in
76+-- 'Binary' instances are compatible with RFC 4122, storing the fields in
78−-- <http://tools.ietf.org/html/rfc4122 RFC 4122>.
77+-- network order as 16 bytes.
78+data UUID
79+ = UUID
79−data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
80+ {-# UNPACK #-} !Word64
81+ {-# UNPACK #-} !Word64
80− deriving (Eq, Ord)
82+ deriving (Eq, Ord, Typeable)
81{-
83{-
82 Prior to uuid-types-1.0.4:
84 Prior to uuid-types-1.0.4:
83 !Word32 !Word32 !Word32 !Word32
85 !Word32 !Word32 !Word32 !Word32
@@ -92,18 +94,10 @@ data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
92 None was as fast, overall, as the representation used here.
94 None was as fast, overall, as the representation used here.
93-}
95-}
94
96
95−-- | Convert a 'UUID' into a sequence of 'Word32' values.
97+-- | Covert a 'UUID' into a sequence of 'Word32' values.
96-- Useful for when you need to serialize a UUID and
98-- Useful for when you need to serialize a UUID and
97-- neither 'Storable' nor 'Binary' are appropriate.
99-- neither 'Storable' nor 'Binary' are appropriate.
98−--
100+-- Introduced in version 1.2.2.
99−-- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000"
100−-- Just (1427014656,3801825748,2803254374,1430519808)
101−--
102−-- See also 'toWords64'.
103−--
104−-- /Since: @uuid-1.2.2@/
105−--
106−-- @since 1.0.0
107toWords :: UUID -> (Word32, Word32, Word32, Word32)
101toWords :: UUID -> (Word32, Word32, Word32, Word32)
108toWords (UUID w12 w34) = (w1, w2, w3, w4)
102toWords (UUID w12 w34) = (w1, w2, w3, w4)
109 where
103 where
@@ -113,49 +107,25 @@ toWords (UUID w12 w34) = (w1, w2, w3, w4)
113 w4 = fromIntegral w34
107 w4 = fromIntegral w34
114
108
115-- | Create a 'UUID' from a sequence of 'Word32'. The
109-- | Create a 'UUID' from a sequence of 'Word32'. The
116−-- inverse of 'toWords'. Useful when you need a total
110+-- opposite of 'toWords'. Useful when you need a total
117-- function for constructing 'UUID' values.
111-- function for constructing 'UUID' values.
118−--
112+-- Introduced in version 1.2.2.
119−-- See also 'fromWords64'.
120−--
121−-- /Since: @uuid-1.2.2@/
122−--
123−-- @since 1.0.0
124fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
113fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
125fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
114fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4)
126
115
127−-- | Convert a 'UUID' into a pair of 'Word64's.
128−--
129−-- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000"
130−-- Just (6128981282234515924,12039885860129472512)
131−--
132−-- See also 'toWords'.
133−--
134−-- @since 1.0.4
135−toWords64 :: UUID -> (Word64, Word64)
136−toWords64 (UUID w12 w34) = (w12,w34)
137−
138−-- | Create a 'UUID' from a pair of 'Word64's.
139−--
140−-- Inverse of 'toWords64'. See also 'fromWords'.
141−--
142−-- @since 1.0.4
143−fromWords64 :: Word64 -> Word64 -> UUID
144−fromWords64 = UUID
145−
146data UnpackedUUID =
116data UnpackedUUID =
147 UnpackedUUID {
117 UnpackedUUID {
148− time_low :: Word32 -- 0-3
118+ time_low :: Word32 -- 0-3
149− , time_mid :: Word16 -- 4-5
119+ , time_mid :: Word16 -- 4-5
150 , time_hi_and_version :: Word16 -- 6-7
120 , time_hi_and_version :: Word16 -- 6-7
151− , clock_seq_hi_res :: Word8 -- 8
121+ , clock_seq_hi_res :: Word8 -- 8
152− , clock_seq_low :: Word8 -- 9
122+ , clock_seq_low :: Word8 -- 9
153− , node_0 :: Word8
123+ , node_0 :: Word8
154− , node_1 :: Word8
124+ , node_1 :: Word8
155− , node_2 :: Word8
125+ , node_2 :: Word8
156− , node_3 :: Word8
126+ , node_3 :: Word8
157− , node_4 :: Word8
127+ , node_4 :: Word8
158− , node_5 :: Word8
128+ , node_5 :: Word8
159 }
129 }
160 deriving (Read, Show, Eq, Ord)
130 deriving (Read, Show, Eq, Ord)
161
131
@@ -195,10 +165,10 @@ pack unpacked =
195
165
196-- |Build a Word32 from four Word8 values, presented in big-endian order
166-- |Build a Word32 from four Word8 values, presented in big-endian order
197word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
167word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
198−word a b c d = (fromIntegral a `unsafeShiftL` 24)
168+word a b c d = (fromIntegral a `shiftL` 24)
199− .|. (fromIntegral b `unsafeShiftL` 16)
169+ .|. (fromIntegral b `shiftL` 16)
200− .|. (fromIntegral c `unsafeShiftL` 8)
170+ .|. (fromIntegral c `shiftL` 8)
201− .|. (fromIntegral d )
171+ .|. (fromIntegral d )
202
172
203-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
173-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
204byte :: Int -> Word64 -> Word8
174byte :: Int -> Word64 -> Word8
@@ -207,7 +177,7 @@ byte i w = fromIntegral (w `shiftR` (i * 8))
207-- |Build a Word16 from two Word8 values, presented in big-endian order.
177-- |Build a Word16 from two Word8 values, presented in big-endian order.
208w8to16 :: Word8 -> Word8 -> Word16
178w8to16 :: Word8 -> Word8 -> Word16
209w8to16 w0s w1s =
179w8to16 w0s w1s =
210− (w0 `unsafeShiftL` 8) .|. w1
180+ (w0 `shiftL` 8) .|. w1
211 where
181 where
212 w0 = fromIntegral w0s
182 w0 = fromIntegral w0s
213 w1 = fromIntegral w1s
183 w1 = fromIntegral w1s
@@ -241,7 +211,7 @@ buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
241 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
211 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
242 b8' = b8 .&. 0x3f .|. 0x80
212 b8' = b8 .&. 0x3f .|. 0x80
243
213
244−-- |Build a UUID of a given version from 'Word32' values.
214+-- |Build a UUID of a given version from Word32 values.
245buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
215buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
246buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3
216buildFromWords v w0 w1 w2 w3 = fromWords w0 w1' w2' w3
247 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
217 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
@@ -275,8 +245,8 @@ null = (== nil)
275 -- null (UUID 0 0 0 0) = True
245 -- null (UUID 0 0 0 0) = True
276 -- null _ = False
246 -- null _ = False
277
247
278−-- |The 'nil' UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
248+-- |The nil UUID, as defined in RFC 4122.
279−-- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@.
249+-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
280nil :: UUID
250nil :: UUID
281nil = UUID 0 0
251nil = UUID 0 0
282
252
@@ -286,8 +256,6 @@ fromByteString :: BL.ByteString -> Maybe UUID
286fromByteString = fromList . BL.unpack
256fromByteString = fromList . BL.unpack
287
257
288-- |Encode a UUID into a 'ByteString' in network order.
258-- |Encode a UUID into a 'ByteString' in network order.
289−--
290−-- This uses the same encoding as the 'Binary' instance.
291toByteString :: UUID -> BL.ByteString
259toByteString :: UUID -> BL.ByteString
292toByteString = BL.pack . toList
260toByteString = BL.pack . toList
293
261
@@ -295,8 +263,9 @@ toByteString = BL.pack . toList
295-- The hyphens may not be omitted.
263-- The hyphens may not be omitted.
296-- Example:
264-- Example:
297--
265--
266+-- @
298−-- >>> fromString "c2cc10e1-57d6-4b6f-9899-38d972112d8c"
267+-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
299−-- Just c2cc10e1-57d6-4b6f-9899-38d972112d8c
268+-- @
300--
269--
301-- Hex digits may be upper or lower-case.
270-- Hex digits may be upper or lower-case.
302fromString :: String -> Maybe UUID
271fromString :: String -> Maybe UUID
@@ -328,39 +297,32 @@ fromString' s0 = do
328-- | Convert a UUID into a hypenated string using lower-case letters.
297-- | Convert a UUID into a hypenated string using lower-case letters.
329-- Example:
298-- Example:
330--
299--
300+-- @
331−-- >>> toString <$> fromString "550e8400-e29b-41d4-a716-446655440000"
301+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
332−-- Just "550e8400-e29b-41d4-a716-446655440000"
302+-- @
333−--
334−--
335toString :: UUID -> String
303toString :: UUID -> String
336−toString uuid = hexw0 w0 $ hexw1 w1 ""
304+toString uuid = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
337− where hexw0 :: Word64 -> String -> String
305+ where hexw :: Word32 -> String -> String
338− hexw0 w s = hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48
339− : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32
340− : '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
306+ hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
341− : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
307+ : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
342− : s
308+
343−
344− hexw1 :: Word64 -> String -> String
309+ hexw' :: Word32 -> String -> String
345− hexw1 w s = '-' : hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48
310+ hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
346− : '-' : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32
347− : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
348− : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0
311+ : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
349− : s
312+
350−
351− hexn :: Word64 -> Int -> Char
313+ hexn :: Word32 -> Int -> Char
352 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
314 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
353
315
354− (w0,w1) = toWords64 uuid
316+ (w0,w1,w2,w3) = toWords uuid
355
317
356-- | If the passed in `Text` can be parsed as an ASCII representation of
318-- | If the passed in `Text` can be parsed as an ASCII representation of
357-- a `UUID`, it will be. The hyphens may not be omitted.
319-- a `UUID`, it will be. The hyphens may not be omitted.
358fromText :: Text -> Maybe UUID
320fromText :: Text -> Maybe UUID
359−fromText = fromASCIIBytes . T.encodeUtf8
321+fromText = fromString . T.unpack
360
322
361-- | Convert a UUID into a hyphentated string using lower-case letters.
323-- | Convert a UUID into a hyphentated string using lower-case letters.
362toText :: UUID -> Text
324toText :: UUID -> Text
363−toText = T.decodeLatin1 . toASCIIBytes
325+toText = T.pack . toString
364
326
365-- | Convert a UUID into a hyphentated string using lower-case letters, packed
327-- | Convert a UUID into a hyphentated string using lower-case letters, packed
366-- as ASCII bytes into `B.ByteString`.
328-- as ASCII bytes into `B.ByteString`.
@@ -455,30 +417,49 @@ fromASCIIBytes bs = do
455-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
417-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
456toLazyASCIIBytes :: UUID -> BL.ByteString
418toLazyASCIIBytes :: UUID -> BL.ByteString
457toLazyASCIIBytes =
419toLazyASCIIBytes =
420+#if MIN_VERSION_bytestring(0,10,0)
458 BL.fromStrict
421 BL.fromStrict
422+#else
423+ BL.fromChunks . return
424+#endif
459 . toASCIIBytes
425 . toASCIIBytes
460
426
461-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
427-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
462fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
428fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
463fromLazyASCIIBytes bs =
429fromLazyASCIIBytes bs =
464− if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
430+ if BL.length bs == 36 then fromASCIIBytes (
431+#if MIN_VERSION_bytestring(0,10,0)
432+ BL.toStrict bs
433+#else
434+ B.concat $ BL.toChunks bs
435+#endif
436+ ) else Nothing
465
437
466--
438--
467-- Class Instances
439-- Class Instances
468--
440--
469
441
470−-- | This 'Random' instance produces __insecure__ version 4 UUIDs as
471−-- specified in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
472instance Random UUID where
442instance Random UUID where
473− random = uniform
443+ random g = (fromGenNext w0 w1 w2 w3 w4, g4)
444+ where (w0, g0) = next g
445+ (w1, g1) = next g0
446+ (w2, g2) = next g1
447+ (w3, g3) = next g2
448+ (w4, g4) = next g3
474 randomR _ = random -- range is ignored
449 randomR _ = random -- range is ignored
475
450
476−-- @since 1.0.4
451+-- |Build a UUID from the results of five calls to next on a StdGen.
477−instance Uniform UUID where
452+-- While next on StdGet returns an Int, it doesn't provide 32 bits of
478− uniformM gen = do
453+-- randomness. This code relies on at last 28 bits of randomness in the
479− w0 <- uniformWord64 gen
454+-- and optimizes its use so as to make only five random values, not six.
480− w1 <- uniformWord64 gen
455+fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
456+fromGenNext w0 w1 w2 w3 w4 =
481− pure $ buildFromBytes 4 /-/ w0 /-/ w1
457+ buildFromBytes 4 /-/ (ThreeByte w0)
458+ /-/ (ThreeByte w1)
459+ /-/ w2 -- use all 4 bytes because we know the version
460+ -- field will "cover" the upper, non-random bits
461+ /-/ (ThreeByte w3)
462+ /-/ (ThreeByte w4)
482
463
483-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
464-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
484-- only returns 31 bits of randomness.
465-- only returns 31 bits of randomness.
@@ -486,8 +467,8 @@ type instance ByteSink ThreeByte g = Takes3Bytes g
486newtype ThreeByte = ThreeByte Int
467newtype ThreeByte = ThreeByte Int
487instance ByteSource ThreeByte where
468instance ByteSource ThreeByte where
488 f /-/ (ThreeByte w) = f b1 b2 b3
469 f /-/ (ThreeByte w) = f b1 b2 b3
489− where b1 = fromIntegral (w `unsafeShiftR` 16)
470+ where b1 = fromIntegral (w `shiftR` 16)
490− b2 = fromIntegral (w `unsafeShiftR` 8)
471+ b2 = fromIntegral (w `shiftR` 8)
491 b3 = fromIntegral w
472 b3 = fromIntegral w
492
473
493instance NFData UUID where
474instance NFData UUID where
@@ -504,11 +485,6 @@ instance Hashable UUID where
504 `hashWithSalt` w2
485 `hashWithSalt` w2
505 `hashWithSalt` w3
486 `hashWithSalt` w3
506
487
507−-- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'.
508−--
509−-- >>> show nil
510−-- "00000000-0000-0000-0000-000000000000"
511−--
512instance Show UUID where
488instance Show UUID where
513 show = toString
489 show = toString
514
490
@@ -519,7 +495,7 @@ instance Read UUID where
519 Nothing -> []
495 Nothing -> []
520 Just u -> [(u,drop 36 noSpaces)]
496 Just u -> [(u,drop 36 noSpaces)]
521
497
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__.
498+
523instance Storable UUID where
499instance Storable UUID where
524 sizeOf _ = 16
500 sizeOf _ = 16
525 alignment _ = 4
501 alignment _ = 4
@@ -556,7 +532,6 @@ instance Storable UUID where
556 pokeByteOff p (off+14) x9
532 pokeByteOff p (off+14) x9
557 pokeByteOff p (off+15) x10
533 pokeByteOff p (off+15) x10
558
534
559−-- | This 'Binary' instance is compatible with <http://tools.ietf.org/html/rfc4122 RFC 4122>, storing the fields in network order as 16 bytes.
560instance Binary UUID where
535instance Binary UUID where
561 put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
536 put (UUID w0 w1) = putWord64be w0 >> putWord64be w1
562 get = liftM2 UUID getWord64be getWord64be
537 get = liftM2 UUID getWord64be getWord64be
@@ -572,4 +547,13 @@ instance Data UUID where
572uuidType :: DataType
547uuidType :: DataType
573uuidType = mkNoRepType "Data.UUID.Types.UUID"
548uuidType = mkNoRepType "Data.UUID.Types.UUID"
574
549
575−deriving instance Lift UUID
550+#if !(MIN_VERSION_base(4,2,0))
551+mkNoRepType :: String -> DataType
552+mkNoRepType = mkNorepType
553+#endif
554+
555+#if !MIN_VERSION_base(4,5,0)
556+unsafeShiftR, unsafeShiftL :: Word64 -> Int -> Word64
557+unsafeShiftR = shiftR
558+unsafeShiftL = shiftL
559+#endif
uuid-types/src/Data/UUID/Types/Internal/Builder.hs → uuid-types/Data/UUID/Types/Internal/Builder.hsrenamed+1−3
@@ -1,9 +1,7 @@
1{-# LANGUAGE TypeFamilies #-}
1{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE Unsafe #-}
3−
4{-# OPTIONS_HADDOCK hide #-}
2{-# OPTIONS_HADDOCK hide #-}
5
3
6−-- | Module : Data.UUID.Types.Internal.Builder
4+-- Module : Data.UUID.Types.Internal.Builder
7-- Copyright : (c) 2009 Mark Lentczner
5-- Copyright : (c) 2009 Mark Lentczner
8--
6--
9-- License : BSD-style
7-- License : BSD-style
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+53−55
@@ -1,22 +1,20 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2
2
3#if !(MIN_VERSION_bytestring(0,10,0))
3#if !(MIN_VERSION_bytestring(0,10,0))
4−{-# OPTIONS_GHC -fno-warn-orphans #-}
5-- Needed for NFData instance
4-- Needed for NFData instance
6−import Control.DeepSeq
5+import Control.DeepSeq
7import qualified Data.ByteString.Lazy.Internal as BL
6import qualified Data.ByteString.Lazy.Internal as BL
8#endif
7#endif
9−import Criterion.Main
8+import Criterion.Main
9+import Data.Maybe (fromJust)
10+import qualified Data.Set as Set
11+import qualified Data.HashSet as HashSet
10−import qualified Data.ByteString.Lazy as BL
12+import qualified Data.ByteString.Lazy as BL
11−import qualified Data.HashSet as HashSet
13+import qualified Data.UUID.Types as U
12−import Data.Maybe (fromJust)
13−import qualified Data.Set as Set
14−import qualified Data.UUID.Types as U
15−import Foreign (alloca, peek, poke)
14+import Foreign (alloca, peek, poke)
16−import System.Random
15+import System.Random
17
16
18#if !(MIN_VERSION_bytestring(0,10,0))
17#if !(MIN_VERSION_bytestring(0,10,0))
19−-- orphan
20instance NFData BL.ByteString where
18instance NFData BL.ByteString where
21 rnf BL.Empty = ()
19 rnf BL.Empty = ()
22 rnf (BL.Chunk _ ts) = rnf ts
20 rnf (BL.Chunk _ ts) = rnf ts
@@ -24,56 +22,56 @@ instance NFData BL.ByteString where
24
22
25main :: IO ()
23main :: IO ()
26main = do
24main = do
27− u1 <- randomIO
25+ u1 <- randomIO
28− let s1 = U.toString u1
26+ let s1 = U.toString u1
29− b1 = U.toByteString u1
27+ b1 = U.toByteString u1
30− a1 = U.toASCIIBytes u1
28+ a1 = U.toASCIIBytes u1
31− t1 = U.toText u1
29+ t1 = U.toText u1
32− (w1a,w1b,w1c,w1d) = U.toWords u1
30+ (w1a,w1b,w1c,w1d) = U.toWords u1
33− nil2 = fromJust $
31+ nil2 = fromJust $
34− U.fromString "00000000-0000-0000-0000-000000000000"
32+ U.fromString "00000000-0000-0000-0000-000000000000"
35− u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"
33+ u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0"
36− u2b = fromJust $ U.fromByteString $
34+ u2b = fromJust $ U.fromByteString $
37− BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,
35+ BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16,
38− 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]
36+ 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0]
39− u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"
37+ u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23"
40
38
41− -- setup for Storable benchmark
39+ -- setup for Storable benchmark
42− alloca $ \ uuidPtr -> do
40+ alloca $ \ uuidPtr -> do
43
41
44− poke uuidPtr u1
42+ poke uuidPtr u1
45
43
46− defaultMain [
44+ defaultMain [
47− bgroup "testing" [
45+ bgroup "testing" [
48− bench "null non-nil" $ whnf U.null u1,
46+ bench "null non-nil" $ whnf U.null u1,
49− bench "null nil" $ whnf U.null U.nil,
47+ bench "null nil" $ whnf U.null U.nil,
50− bench "null nil2" $ whnf U.null nil2,
48+ bench "null nil2" $ whnf U.null nil2,
51− bench "eq same" $ whnf (==u2a) u2b,
49+ bench "eq same" $ whnf (==u2a) u2b,
52− bench "eq differ" $ whnf (==u2a) u3,
50+ bench "eq differ" $ whnf (==u2a) u3,
53− bench "compare same" $ whnf (compare u2a) u2b,
51+ bench "compare same" $ whnf (compare u2a) u2b,
54− bench "compare differ" $ whnf (compare u2a) u3
52+ bench "compare differ" $ whnf (compare u2a) u3
55− ],
53+ ],
56− bgroup "conversion" [
54+ bgroup "conversion" [
57− bench "toString" $ nf U.toString u1,
55+ bench "toString" $ nf U.toString u1,
58− bench "fromString" $ nf U.fromString s1,
56+ bench "fromString" $ nf U.fromString s1,
59− bench "toByteString" $ nf U.toByteString u1,
57+ bench "toByteString" $ nf U.toByteString u1,
60− bench "fromByteString" $ nf U.fromByteString b1,
58+ bench "fromByteString" $ nf U.fromByteString b1,
61− bench "toASCIIBytes" $ nf U.toASCIIBytes u1,
59+ bench "toASCIIBytes" $ nf U.toASCIIBytes u1,
62− bench "fromASCIIBytes" $ nf U.fromASCIIBytes a1,
60+ bench "fromASCIIBytes" $ nf U.fromASCIIBytes a1,
63− bench "toWords" $ nf U.toWords u1,
61+ bench "toWords" $ nf U.toWords u1,
64− bench "fromWords" $ nf (U.fromWords w1a w1b w1c) w1d,
62+ bench "fromWords" $ nf (U.fromWords w1a w1b w1c) w1d,
65− bench "toText" $ nf U.toText u1,
63+ bench "toText" $ nf U.toText u1,
66− bench "fromText" $ nf U.fromText t1
64+ bench "fromText" $ nf U.fromText t1
67− ],
65+ ],
68
66
69− bench "Set making" $ nf Set.fromList uuids,
67+ bench "Set making" $ nf Set.fromList uuids,
70− bench "HashSet making" $ nf HashSet.fromList uuids,
68+ bench "HashSet making" $ nf HashSet.fromList uuids,
71
69
72− bgroup "storable" [
70+ bgroup "storable" [
73− bench "peek" $ nfIO (peek uuidPtr),
71+ bench "peek" $ nfIO (peek uuidPtr),
74− bench "poke" $ whnfIO $ poke uuidPtr u1
72+ bench "poke" $ whnfIO $ poke uuidPtr u1
73+ ]
75 ]
74 ]
76− ]
77
75
78-- 50 uuids, so tests can be repeatable
76-- 50 uuids, so tests can be repeatable
79uuids :: [U.UUID]
77uuids :: [U.UUID]
uuid-types/tests/TestUUID.hs+15−49
@@ -1,29 +1,22 @@
1{-# LANGUAGE ViewPatterns #-}
1{-# LANGUAGE ViewPatterns #-}
2−{-# LANGUAGE TemplateHaskell #-}
3
2
4−{-# OPTIONS_GHC -fno-warn-orphans #-}
5−
6−import Data.Binary (encode)
7−import qualified Data.ByteString.Char8 as BC8
8−import qualified Data.ByteString.Lazy as BL
3+import qualified Data.ByteString.Lazy as BL
9import qualified Data.ByteString.Lazy.Char8 as BL8
4import qualified Data.ByteString.Lazy.Char8 as BL8
5+import qualified Data.ByteString.Char8 as BC8
10−import Data.Char (ord)
6+import Data.Char (ord)
11−import Data.Functor ((<$>))
7+import Data.Functor ((<$>))
8+import Data.Word
12−import qualified Data.UUID.Types as U
9+import qualified Data.UUID.Types as U
13−import Data.Word
14−import Foreign (alloca, castPtr, peek, poke,
10+import Foreign (alloca, peek, poke)
15− sizeOf)
16−import GHC.ByteOrder (ByteOrder(..), targetByteOrder)
17−import System.IO.Unsafe (unsafePerformIO)
11+import System.IO.Unsafe (unsafePerformIO)
18
12
19−import Test.QuickCheck (Arbitrary (arbitrary), choose)
13+import Test.QuickCheck ( Arbitrary(arbitrary), choose )
20
14
21−import Test.Tasty (TestTree, defaultMain, testGroup)
15+import Test.Tasty ( defaultMain, TestTree, testGroup )
22−import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))
16+import Test.Tasty.HUnit ( assertBool, (@?=), (@=?), testCase )
23−import Test.Tasty.QuickCheck (testProperty)
17+import Test.Tasty.QuickCheck ( testProperty )
24
18
25
19
26−-- orphan
27instance Arbitrary U.UUID where
20instance Arbitrary U.UUID where
28 -- the UUID random instance ignores bounds
21 -- the UUID random instance ignores bounds
29 arbitrary = choose (U.nil, U.nil)
22 arbitrary = choose (U.nil, U.nil)
@@ -41,11 +34,6 @@ test_nil = testGroup "nil" [
41 testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)
34 testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)
42 ]
35 ]
43
36
44−test_lift :: Test
45−test_lift = testCase "TH.Lift" $ do
46− let uuid = U.fromWords64 123456789 987654321
47− uuid @?= $( [| uuid |] )
48−
49test_conv :: Test
37test_conv :: Test
50test_conv = testGroup "conversions" [
38test_conv = testGroup "conversions" [
51 testCase "conv bytes to string" $
39 testCase "conv bytes to string" $
@@ -61,32 +49,13 @@ test_fromByteString :: Test
61test_fromByteString =
49test_fromByteString =
62 testCase "UUID fromByteString" $
50 testCase "UUID fromByteString" $
63 Just inputUUID @=?
51 Just inputUUID @=?
64− U.fromByteString (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2")
52+ U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")
65
53
66-- | Test fromWords with a fixed-input
54-- | Test fromWords with a fixed-input
67test_fromWords :: Test
55test_fromWords :: Test
68test_fromWords =
56test_fromWords =
69 testCase "UUID fromWords" $
57 testCase "UUID fromWords" $
70− inputUUID @=? U.fromWords 0xa5ca8566 0xd9c54835 0x99c8e1f1 0x3e73b5e2
58+ inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594
71−
72−
73−test_Storeable :: Test
74−test_Storeable =
75− testCase "UUID Storeable(poke)" $
76− case targetByteOrder of
77− LittleEndian -> BC8.pack "\x66\x85\xca\xa5\xc5\xd9\x35\x48\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID
78− BigEndian -> BC8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID
79− where
80− pokeAsBS :: U.UUID -> BC8.ByteString
81− pokeAsBS uuid = unsafePerformIO $ do
82− alloca $ \ptr -> do
83− poke ptr uuid
84− BC8.packCStringLen (castPtr ptr, sizeOf uuid)
85−
86−test_Binary :: Test
87−test_Binary =
88− testCase "UUID Binary(encode)" $
89− (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2") @=? encode inputUUID
90
59
91inputUUID :: U.UUID
60inputUUID :: U.UUID
92inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
61inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
@@ -182,12 +151,9 @@ main = do
182 [ [
151 [ [
183 test_null,
152 test_null,
184 test_nil,
153 test_nil,
185− test_lift,
186 test_conv,
154 test_conv,
187 test_fromByteString,
155 test_fromByteString,
188− test_fromWords,
156+ test_fromWords
189− test_Storeable,
190− test_Binary
191 ]
157 ]
192 , [ prop_stringRoundTrip,
158 , [ prop_stringRoundTrip,
193 prop_readShowRoundTrip,
159 prop_readShowRoundTrip,
uuid-types/tests/summarize-bench-results.plnew file+14
@@ -0,0 +1,14 @@
1+#!/usr/bin/env perl
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−90
@@ -1,99 +1,80 @@
1−cabal-version: 1.12
2−name: uuid-types
1+Name: uuid-types
3−version: 1.0.6
2+Version: 1.0.3
4−x-revision: 2
5−copyright:
6− (c) 2017-2018 Herbert Valerio Riedel
7− (c) 2008-2014 Antoine Latter
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.8
11+Tested-With: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2
8
12
9−author: Antoine Latter
13+Synopsis: Type definitions for Universally Unique Identifiers
10−maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
14+Description:
11−license: BSD3
15+ This library contains type definitions for Universally Unique Identifiers
12−license-file: LICENSE
16+ and basic conversion functions.
13−category: Data
17+ .
14−build-type: Simple
18+ See <http://en.wikipedia.org/wiki/UUID> for the general idea.
15−tested-with:
16− GHC ==8.6.5
17− || ==8.8.4
18− || ==8.10.7
19− || ==9.0.2
20− || ==9.2.8
21− || ==9.4.8
22− || ==9.6.6
23− || ==9.8.4
24− || ==9.10.1
25− || ==9.12.1
26
19
27−synopsis: Type definitions for Universally Unique Identifiers
20+Homepage: https://github.com/hvr/uuid
28−description:
21+Bug-Reports: https://github.com/hvr/uuid/issues
29− This library contains type definitions for
30− <https://en.wikipedia.org/wiki/UUID Universally Unique Identifiers (UUID)>
31− (as specified in
32− <http://tools.ietf.org/html/rfc4122 RFC 4122>)
33− and basic conversion functions.
34− .
35− See also the <https://hackage.haskell.org/package/uuid 'uuid' package>
36− providing a high-level API for managing the different UUID versions.
37
22
38−homepage: https://github.com/haskell-hvr/uuid
23+Extra-Source-Files:
39−bug-reports: https://github.com/haskell-hvr/uuid/issues
24+ CHANGES
40−extra-source-files: ChangeLog.md
41
25
42−source-repository head
26+Source-Repository head
43− type: git
27+ Type: git
44− location: https://github.com/haskell-hvr/uuid.git
28+ Location: https://github.com/hvr/uuid.git
45− subdir: uuid-types
29+ Subdir: uuid-types
46
30
47−library
31+Library
48− build-depends:
32+ Build-Depends: base >= 3 && < 5,
49− base >=4.12.0.0 && <5
50− , binary >=0.8.6.0 && <0.9
33+ binary >= 0.4 && < 0.9,
51− , bytestring >=0.10.8.2 && <0.13
34+ bytestring >= 0.9 && < 0.11,
52− , deepseq >=1.4.4.0 && <1.6
35+ deepseq >= 1.3 && < 1.5,
53− , hashable >=1.4.4.0 && <1.6
36+ hashable (>= 1.1.1.0 && < 1.2) || (>= 1.2.1 && < 1.3),
54− , random >=1.2.1.2 && <1.3
37+ random >= 1.0.1 && < 1.2,
55− , template-haskell >=2.14.0.0 && <2.24
56− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
38+ text >= 1 && < 1.3
57
39
40+ Exposed-Modules:
41+ Data.UUID.Types
42+ -- Exposed for companion projects; *NOT* part of the official API:
43+ Data.UUID.Types.Internal.Builder
58− exposed-modules: Data.UUID.Types
44+ Data.UUID.Types.Internal
59
45
60− -- Exposed for companion projects; *NOT* part of the official API:
46+ Extensions: DeriveDataTypeable
61− exposed-modules:
47+ Other-Extensions: TypeFamilies
62− Data.UUID.Types.Internal
48+ Ghc-Options: -Wall
63− Data.UUID.Types.Internal.Builder
64
49
65− default-language: Haskell2010
50+Test-Suite testuuid
66− other-extensions:
51+ Type: exitcode-stdio-1.0
52+ Main-is: TestUUID.hs
53+ Hs-source-dirs: tests
67− DeriveDataTypeable
54+ Extensions: DeriveDataTypeable
68− TypeFamilies
55+ Other-Extensions: ViewPatterns
56+ Ghc-Options: -Wall -fno-warn-orphans
57+ Build-Depends: uuid-types
58+ Build-Depends: base >= 3 && < 5,
59+ bytestring >= 0.9 && < 0.11,
60+ HUnit >= 1.2 && < 1.4,
61+ QuickCheck >= 2.4 && < 2.10,
62+ tasty >= 0.10 && < 0.12,
63+ tasty-hunit == 0.9.*,
64+ tasty-quickcheck == 0.8.*
69
65
70− ghc-options: -Wall
66+benchmark benchmark
71− hs-source-dirs: src
72−
73−test-suite testuuid
74− type: exitcode-stdio-1.0
67+ Type: exitcode-stdio-1.0
75− main-is: TestUUID.hs
68+ Main-is: BenchUUID.hs
76− hs-source-dirs: tests
69+ Hs-source-dirs: tests
77− default-language: Haskell2010
70+ Extensions: DeriveDataTypeable
78− other-extensions: ViewPatterns
71+ Other-Extensions: CPP
79− ghc-options: -Wall
72+ Ghc-Options: -Wall -fno-warn-orphans
80− if impl(ghc >= 8.10)
73+ Build-Depends: uuid-types
81− ghc-options: -Wunused-packages
82−
83− -- inherited constraints
84− build-depends:
74+ Build-depends: base == 4.*,
85− base
86− , binary
87− , bytestring
75+ bytestring >= 0.9 && < 0.11,
88− , template-haskell
76+ containers >= 0.4 && < 0.6,
89− , uuid-types
77+ criterion >= 0.4 && < 1.2,
90−
78+ deepseq >= 1.1 && < 1.5,
91− -- deps w/o inherited constraints
79+ random >= 1.0.1 && < 1.2,
92− build-depends:
80+ unordered-containers >= 0.2.7 && < 0.3
93− QuickCheck >=2.14.2 && <2.16
94− , tasty >=1.4.0.1 && <1.6
95− , tasty-hunit >=0.10 && <0.11
96− , tasty-quickcheck >=0.10 && <0.12
97−
98− if !impl(ghc >=8.4)
99− build-depends: ghc-byteorder >=4.11 && <4.12
uuid/CHANGES.md+1−15
@@ -1,23 +1,9 @@
1−1.3.16
2−
3−- Support GHC-8.6.5...9.10.1
4−
5−1.3.15
6−
7−- Add (Template Haskell) `Lift UUID` instance
8−
9−1.3.14
10−
11−- Use more compact heap object representation which saves 16 bytes on 64bit platforms.
12−- Add `toWords64`/`fromWords64` functions
13−
141.3.13
11.3.13
15
2
16- Optimize `V4.nextRandom` (~3x speed increase)
3- Optimize `V4.nextRandom` (~3x speed increase)
17- Optimize UUID V3 & V5 generation (~2x speed increase)
4- Optimize UUID V3 & V5 generation (~2x speed increase)
18- Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead
5- Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead
19− of `memory`/`cryptonite` for better performance and stability,
6+ of `memory`/`cryptonite` for better performance and stability.
20− but GHCJS is now no longer supported.
21- Update cabal-spec to version 1.10
7- Update cabal-spec to version 1.10
22
8
231.3.12
91.3.12
uuid/src/Data/UUID.hs → uuid/Data/UUID.hsrenamed+3−2
@@ -18,6 +18,9 @@ See <http://tools.ietf.org/html/rfc4122> for the specification.
18favorite instance of 'System.Random.Random' for faster but insecure
18favorite instance of 'System.Random.Random' for faster but insecure
19generation of UUIDs.
19generation of UUIDs.
20
20
21+* We have an implementation of generating a UUID from the hardware
22+MAC address and current system time in "Data.UUID.V1".
23+
21* For name-based generation of UUIDs using SHA-1 hashing see
24* For name-based generation of UUIDs using SHA-1 hashing see
22"Data.UUID.V5".
25"Data.UUID.V5".
23-}
26-}
@@ -34,8 +37,6 @@ module Data.UUID(UUID
34 ,fromByteString
37 ,fromByteString
35 ,toWords
38 ,toWords
36 ,fromWords
39 ,fromWords
37− ,toWords64
38− ,fromWords64
39 ,null
40 ,null
40 ,nil
41 ,nil
41 ) where
42 ) where
uuid/src/Data/UUID/Named.hs → uuid/Data/UUID/Named.hsrenamed

The content is the same.

uuid/src/Data/UUID/Util.hs → uuid/Data/UUID/Util.hsrenamed+11
@@ -3,6 +3,7 @@ module Data.UUID.Util (
3 UnpackedUUID(..)
3 UnpackedUUID(..)
4 , unpack, pack
4 , unpack, pack
5 , version
5 , version
6+ , extractMac
6 , extractTime
7 , extractTime
7 , setTime
8 , setTime
8 ) where
9 ) where
@@ -12,6 +13,7 @@ import Data.Word
12import Data.Word.Util
13import Data.Word.Util
13import Data.Bits
14import Data.Bits
14import Data.UUID.Types.Internal
15import Data.UUID.Types.Internal
16+import Network.Info
15import Data.Int (Int64)
17import Data.Int (Int64)
16
18
17version :: UUID -> Int
19version :: UUID -> Int
@@ -40,3 +42,12 @@ extractTime uuid =
40
42
41timeAndVersionToTime :: Word16 -> Word16
43timeAndVersionToTime :: Word16 -> Word16
42timeAndVersionToTime tv = tv .&. 0x0FFF
44timeAndVersionToTime tv = tv .&. 0x0FFF
45+
46+extractMac :: UUID -> Maybe MAC
47+extractMac uuid =
48+ if version uuid == 1
49+ then Just $
50+ MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked)
51+ else Nothing
52+ where
53+ unpacked = unpack uuid
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
8Stability : experimental
8Stability : experimental
9Portability : portable
9Portability : portable
10
10
11−NOTE\: This module uses MD5 hashing. Unless you know
11+NOTE: This module uses MD5 hashing. Unless you know
12you need to use this module, you should probably be
12you need to use this module, you should probably be
13using "Data.UUID.V5", which offers the same sort of
13using "Data.UUID.V5", which offers the same sort of
14functionality as this module except implemented with
14functionality as this module except implemented with
uuid/src/Data/UUID/V4.hs → uuid/Data/UUID/V4.hsrenamed+8−6
@@ -11,9 +11,12 @@
11 This module implements Version 4 UUIDs as specified
11 This module implements Version 4 UUIDs as specified
12 in RFC 4122.
12 in RFC 4122.
13
13
14− These UUIDs are generated from a pseudo-random generator.
14+ These UUIDs are generated from a psuedo-random generator.
15− We use the 'getEntropy' method from the <https://hackage.haskell.org/package/entropy entropy> package,
15+ We use the System.Random 'R.StdGen' as our random source.
16− which should provide cryptographically secure random data.
16+
17+ All of the logic is encapsulated in the 'R.Random' instance
18+ for the UUID type, so you are also free to use the random generator
19+ of your choice.
17-}
20-}
18module Data.UUID.V4 (nextRandom) where
21module Data.UUID.V4 (nextRandom) where
19
22
@@ -23,9 +26,8 @@ import Data.UUID.Types.Internal ( buildFromBytes )
23import System.Entropy ( getEntropy )
26import System.Entropy ( getEntropy )
24import Data.ByteString ( unpack )
27import Data.ByteString ( unpack )
25
28
26−-- | Generate a crytographically secure, random UUID.
29+-- | Generate a crytographically secure, random UUID. Introduced in version
27−--
28−-- @since 1.2.6
30+-- 1.2.6.
29nextRandom :: IO UUID
31nextRandom :: IO UUID
30nextRandom = do
32nextRandom = do
31 [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]
33 [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]
uuid/src/Data/UUID/V5.hs → uuid/Data/UUID/V5.hsrenamed

The content is the same.

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

The content is the same.

uuid-bench/bench/uuid-benchmark.hs → uuid/tests/BenchUUID.hsrenamed+1
@@ -3,6 +3,7 @@ import Data.Char (ord)
3import Data.IORef
3import Data.IORef
4import Data.Word
4import Data.Word
5import qualified Data.UUID as U
5import qualified Data.UUID as U
6+import qualified Data.UUID.V1 as U
6import qualified Data.UUID.V4 as U
7import qualified Data.UUID.V4 as U
7import qualified Data.UUID.V3 as U3
8import qualified Data.UUID.V3 as U3
8import qualified Data.UUID.V5 as U5
9import qualified Data.UUID.V5 as U5
uuid/tests/TestUUID.hs+21−5
@@ -1,18 +1,21 @@
1{-# LANGUAGE ViewPatterns #-}
1{-# LANGUAGE ViewPatterns #-}
2
2
3+import Control.Monad (replicateM)
3import Data.Bits
4import Data.Bits
4import qualified Data.ByteString.Lazy as BL
5import qualified Data.ByteString.Lazy as BL
5import Data.Char (ord)
6import Data.Char (ord)
7+import Data.List (nub, (\\))
6import Data.Maybe
8import Data.Maybe
7import Data.Word
9import Data.Word
8import qualified Data.UUID as U
10import qualified Data.UUID as U
11+import qualified Data.UUID.V1 as U
9import qualified Data.UUID.V3 as U3
12import qualified Data.UUID.V3 as U3
10import qualified Data.UUID.V5 as U5
13import qualified Data.UUID.V5 as U5
11
14
12−import Test.QuickCheck ( Arbitrary(arbitrary) )
15+import Test.QuickCheck ( Arbitrary(arbitrary), choose )
13import Test.Tasty ( TestTree, testGroup, defaultMain )
16import Test.Tasty ( TestTree, testGroup, defaultMain )
14import Test.Tasty.HUnit
17import Test.Tasty.HUnit
15− ( assertBool, (@?=), testCase )
18+ ( Assertable(assert), assertBool, (@?=), testCase )
16import Test.Tasty.QuickCheck ( testProperty )
19import Test.Tasty.QuickCheck ( testProperty )
17
20
18type Test = TestTree
21type Test = TestTree
@@ -21,13 +24,13 @@ isValidVersion :: Int -> U.UUID -> Bool
21isValidVersion v u = lenOK && variantOK && versionOK
24isValidVersion v u = lenOK && variantOK && versionOK
22 where bs = U.toByteString u
25 where bs = U.toByteString u
23 lenOK = BL.length bs == 16
26 lenOK = BL.length bs == 16
24− variantOK = BL.index bs 8 .&. 0xc0 == 0x80
27+ variantOK = (BL.index bs 8) .&. 0xc0 == 0x80
25− versionOK = BL.index bs 6 .&. 0xf0 == fromIntegral (v `shiftL` 4)
28+ versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
26
29
27
30
28instance Arbitrary U.UUID where
31instance Arbitrary U.UUID where
29 -- the UUID random instance ignores bounds
32 -- the UUID random instance ignores bounds
30− arbitrary = pure U.nil
33+ arbitrary = choose (U.nil, U.nil)
31
34
32
35
33test_null :: Test
36test_null :: Test
@@ -35,6 +38,17 @@ test_null =
35 testCase "namespaceDNS is not null" $
38 testCase "namespaceDNS is not null" $
36 assertBool "" (not $ U.null U3.namespaceDNS)
39 assertBool "" (not $ U.null U3.namespaceDNS)
37
40
41+test_v1 :: [Maybe U.UUID] -> Test
42+test_v1 v1s = testGroup "version 1" [
43+ testCase "V1 unique" $ nub (v1s \\ nub v1s) @?= [],
44+ testGroup "V1 not null" $ map (testUUID (not . U.null)) v1s,
45+ testGroup "V1 valid" $ map (testUUID (isValidVersion 1)) v1s
46+ ]
47+ where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test
48+ testUUID p u =
49+ testCase (show u) $
50+ assert $ maybe False p u
51+
38test_v3 :: Test
52test_v3 :: Test
39test_v3 =
53test_v3 =
40 testCase "V3 computation" $
54 testCase "V3 computation" $
@@ -79,11 +93,13 @@ prop_v5Valid = testProperty "V5 valid" v5Valid
79
93
80main :: IO ()
94main :: IO ()
81main = do
95main = do
96+ v1s <- replicateM 100 U.nextUUID
82 defaultMain $
97 defaultMain $
83 testGroup "tests" $
98 testGroup "tests" $
84 concat $
99 concat $
85 [ [
100 [ [
86 test_null,
101 test_null,
102+ test_v1 v1s,
87 test_v3,
103 test_v3,
88 test_v5
104 test_v5
89 ]
105 ]
uuid/tests/summarize-bench-results.plnew file+14
@@ -0,0 +1,14 @@
1+#!/usr/bin/env perl
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
1+Name: uuid
3−version: 1.3.16
2+Version: 1.3.13
4−x-revision: 2
5−copyright: (c) 2008-2014 Antoine Latter
3+Copyright: (c) 2008-2014 Antoine Latter
6−author: Antoine Latter
4+Author: Antoine Latter
7−maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
5+Maintainer: hvr@gnu.org
8−license: BSD3
6+License: BSD3
9−license-file: LICENSE
7+License-file: LICENSE
10−category: Data
8+Category: Data
11−build-type: Simple
9+Build-Type: Simple
12−tested-with:
10+Cabal-Version: >= 1.10
13− GHC ==8.6.5
11+Tested-With: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2
14− || ==8.8.4
15− || ==8.10.7
16− || ==9.0.2
17− || ==9.2.8
18− || ==9.4.8
19− || ==9.6.6
20− || ==9.8.4
21− || ==9.10.1
22− || ==9.12.1
23
12
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.
26
19
27−description:
20+Homepage: https://github.com/hvr/uuid
28− This library is useful for creating, comparing, parsing and
21+Bug-Reports: https://github.com/hvr/uuid/issues
29− printing Universally Unique Identifiers.
30− .
31− See <http://en.wikipedia.org/wiki/UUID> for the general idea.
32
22
33−homepage: https://github.com/haskell-hvr/uuid
23+Extra-Source-Files:
34−bug-reports: https://github.com/haskell-hvr/uuid/issues
35−extra-source-files: CHANGES.md
24+ CHANGES.md
36
25
37−source-repository head
26+Source-Repository head
38− type: git
27+ Type: git
39− location: https://github.com/haskell-hvr/uuid.git
28+ Location: https://github.com/hvr/uuid.git
40− subdir: uuid
29+ Subdir: uuid
41
30
42−library
31+Library
43− build-depends:
44− base >=4.12 && <5
32+ Build-Depends: base >= 4.3 && < 5,
45− , binary >=0.8.6.0 && <0.9
33+ binary >= 0.4 && < 0.9,
46− , bytestring >=0.10.8.2 && <0.13
34+ bytestring >= 0.10 && < 0.11,
35+ cryptohash-sha1 >= 0.11.100 && < 0.12,
47− , cryptohash-md5 >=0.11.100 && <0.12
36+ cryptohash-md5 >= 0.11.100 && < 0.12,
48− , cryptohash-sha1 >=0.11.100 && <0.12
49− , entropy >=0.3.7 && <0.5
37+ entropy >= 0.3.7 && < 0.4,
38+ network-info == 0.2.*,
39+ random >= 1.0.1 && < 1.2,
40+ time >= 1.1 && < 1.8,
41+ text >= 1 && < 1.3,
42+ uuid-types >= 1.0.2 && < 2
50
43
51− -- strict dependency on uuid-types,
44+ Exposed-Modules:
52− -- as we re-rexport datatype, thus leak instances etc.
53− build-depends: uuid-types >=1.0.6 && <1.0.7
54− exposed-modules:
55− Data.UUID
45+ Data.UUID
56− Data.UUID.Util
46+ Data.UUID.Util
47+ Data.UUID.V1
57− Data.UUID.V3
48+ Data.UUID.V3
58− Data.UUID.V4
49+ Data.UUID.V4
59− Data.UUID.V5
50+ Data.UUID.V5
60
51
61− other-modules:
52+ Other-Modules:
62− Data.UUID.Named
53+ Data.UUID.Named
63− Data.Word.Util
54+ Data.Word.Util
64
55
65− default-language: Haskell2010
56+ Default-Language: Haskell2010
66− default-extensions: DeriveDataTypeable
57+ Default-Extensions: DeriveDataTypeable
67− other-extensions: TypeFamilies
58+ Other-Extensions: TypeFamilies
68− ghc-options: -Wall
59+ Ghc-Options: -Wall
69− if impl(ghc >= 8.10)
70− ghc-options: -Wunused-packages
71− hs-source-dirs: src
72
60
73−test-suite testuuid
61+Test-Suite testuuid
74− type: exitcode-stdio-1.0
62+ Type: exitcode-stdio-1.0
75− main-is: TestUUID.hs
63+ Main-is: TestUUID.hs
76− hs-source-dirs: tests
64+ Hs-source-dirs: tests
77− default-language: Haskell2010
65+ Default-Language: Haskell2010
78− default-extensions: DeriveDataTypeable
66+ Default-Extensions: DeriveDataTypeable
79− other-extensions: ViewPatterns
67+ Other-Extensions: ViewPatterns
80− ghc-options: -Wall -fno-warn-orphans
68+ Ghc-Options: -Wall -fno-warn-orphans
81− if impl(ghc >= 8.10)
69+ Build-Depends: uuid
82− ghc-options: -Wunused-packages
70+ Build-Depends: base >= 4.3 && < 5,
71+ bytestring >= 0.9 && < 0.11,
72+ HUnit >= 1.2 && < 1.4,
73+ QuickCheck >= 2.4 && < 2.10,
74+ random >= 1.0.1 && < 1.2,
75+ tasty >= 0.10 && < 0.12,
76+ tasty-hunit == 0.9.*,
77+ tasty-quickcheck == 0.8.*
83
78
84− -- inherited constraints
79+benchmark benchmark
85− build-depends:
80+ Type: exitcode-stdio-1.0
86− base
81+ Main-is: BenchUUID.hs
87− , bytestring
82+ Hs-source-dirs: tests
83+ Default-Language: Haskell2010
84+ Default-Extensions: DeriveDataTypeable, CPP
85+ Ghc-Options: -Wall -fno-warn-orphans
88− , uuid
86+ Build-Depends: uuid
89−
87+ Build-Depends: base >= 4.3 && < 5,
90− -- deps w/o inherited constraints
88+ criterion >= 0.4 && < 1.2,
91− build-depends:
89+ mersenne-random-pure64 >= 0.2 && < 0.3,
92− QuickCheck >=2.14.2 && <2.16
90+ random >= 1.0.1 && < 1.2
93− , tasty >=1.4.0.1 && <1.6
94− , tasty-hunit >=0.10 && <0.11
95− , tasty-quickcheck >=0.10 && <0.12