Compare commits
306
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a46ac79ea8 | ||
|
|
a2faa667f3 | ||
|
|
366502729d | ||
|
|
7c8f79d86f | ||
|
|
827121b72f | ||
|
|
d4949c633e | ||
|
|
a4880f0372 | ||
|
|
daad7c317d | ||
|
|
20f2e894c9 | ||
|
|
5a98f0c26d | ||
|
|
4680e62d7b | ||
|
|
cd83ebec00 | ||
|
|
e40b7351ec | ||
|
|
3e249724fd | ||
|
|
1b453b6064 | ||
|
|
3611929f01 | ||
|
|
f8cf1375d5 | ||
|
|
ee4d94feab | ||
|
|
4e11d80eb7 | ||
|
|
84d228a3b5 | ||
|
|
f162c21d1b | ||
|
|
e613ed4dd2 | ||
|
|
36ce510547 | ||
|
|
22e2cecaee | ||
|
|
0a92513108 | ||
|
|
9309ca3107 | ||
|
|
8ff8b7ae49 | ||
|
|
68f668951f | ||
|
|
7e081500f3 | ||
|
|
2666f1e830 | ||
|
|
03f73d8cde | ||
|
|
af6cabe185 | ||
|
|
e7a8e99f3f | ||
|
|
0fda50b372 | ||
|
|
76ad00a018 | ||
|
|
e9da6f635e | ||
|
|
e02ac85388 | ||
|
|
3dd5152aba | ||
|
|
0ea2c5146a | ||
|
|
612726f87e | ||
|
|
4d1f8dc86b | ||
|
|
1277dfd941 | ||
|
|
a645953330 | ||
|
|
fa0f1dc0fa | ||
|
|
5e1b1ea982 | ||
|
|
f39de46d9f | ||
|
|
95ccde5a2d | ||
|
|
b8fa8a0729 | ||
|
|
ae9dd77749 | ||
|
|
66d6d3506f | ||
|
|
357c0fdbed | ||
|
|
a93c7e6343 | ||
|
|
65c61c1d63 | ||
|
|
2770a143d0 | ||
|
|
c649da1944 | ||
|
|
9d450cd9ff | ||
|
|
7491e92f2a | ||
|
|
3add75ac4d | ||
|
|
278b6c59e6 | ||
|
|
ff8ed02b81 | ||
|
|
cfa026a068 | ||
|
|
a69d4ec1dd | ||
|
|
b45c3e6e73 | ||
|
|
b1f7eb5899 | ||
|
|
8bf457d6b7 | ||
|
|
8c3c133342 | ||
|
|
ced5fd366e | ||
|
|
8c88bc7d64 | ||
|
|
5024f3fef9 | ||
|
|
1b1f82b749 | ||
|
|
f75c99bda8 | ||
|
|
7c0e45c844 | ||
|
|
ace10b648c | ||
|
|
8a8eb8c728 | ||
|
|
3bd6f07f9b | ||
|
|
d6a710e40e | ||
|
|
675837c232 | ||
|
|
243a309bc1 | ||
|
|
60943c0596 | ||
|
|
a8d1363581 | ||
|
|
57912017fe | ||
|
|
f542a361a4 | ||
|
|
70fca4ab9c | ||
|
|
81dcc985fc | ||
|
|
9a61a70a19 | ||
|
|
8c9d0f4666 | ||
|
|
fd7fc5fb8e | ||
|
|
65a0518008 | ||
|
|
7f29497262 | ||
|
|
6d2a32f0dd | ||
|
|
74f185e22f | ||
|
|
8db43f6bff | ||
|
|
4694fee383 | ||
|
|
2d8d1f3357 | ||
|
|
d462550f07 | ||
|
|
c9a2d176d1 | ||
|
|
8eb1633dd8 | ||
|
|
2c44add128 | ||
|
|
62393669dc | ||
|
|
abf2fbc369 | ||
|
|
72085dec92 | ||
|
|
923194c5b2 | ||
|
|
5964f545cf | ||
|
|
8387808d6e | ||
|
|
2cd38fcb03 | ||
|
|
9533e739ff | ||
|
|
6c9b60700e | ||
|
|
7908bad846 | ||
|
|
bfc7306ed7 | ||
|
|
63d561de0c | ||
|
|
3175e6c1eb | ||
|
|
eccb07f726 | ||
|
|
459d82012b | ||
|
|
5717b9a42c | ||
|
|
d7bc982142 | ||
|
|
d30d6a39ab | ||
|
|
46220a1a4a | ||
|
|
c2570f77e6 | ||
|
|
b4d33c3c96 | ||
|
|
8c676e28de | ||
|
|
a2c66fc236 | ||
|
|
456a063e35 | ||
|
|
269c81b1d2 | ||
|
|
307ecd7d6a | ||
|
|
41710698ee | ||
|
|
8b9197ff01 | ||
|
|
89d4a49c7e | ||
|
|
ca5087201b | ||
|
|
8ad2522cda | ||
|
|
5866877d3f | ||
|
|
92905843a4 | ||
|
|
a324e26d54 | ||
|
|
79bbc2de6e | ||
|
|
721374d42c | ||
|
|
0ab61665ee | ||
|
|
6ac3e01da0 | ||
|
|
fd3d667cde | ||
|
|
f9b5a5cbf4 | ||
|
|
12cd9fae46 | ||
|
|
531a07ccfc | ||
|
|
e72d06929e | ||
|
|
39d56792ce | ||
|
|
3994639b2b | ||
|
|
03f5746e96 | ||
|
|
070ac54067 | ||
|
|
e452604224 | ||
|
|
e836d3f690 | ||
|
|
51fdf38c71 | ||
|
|
d0e81532af | ||
|
|
4a2ea2735b | ||
|
|
6d3940b4e5 | ||
|
|
254dafcb12 | ||
|
|
33e412b59b | ||
|
|
5ce97cd0e9 | ||
|
|
1140df0f91 | ||
|
|
ed6fa9c8ea | ||
|
|
1f2ed3e4cb | ||
|
|
cc0565112f | ||
|
|
0fb7730b0c | ||
|
|
d6d1004070 | ||
|
|
c7eeb5349e | ||
|
|
257a38f68f | ||
|
|
66958def93 | ||
|
|
c692eb03fb | ||
|
|
a33669ca6d | ||
|
|
6cb17bb94b | ||
|
|
00c2fce11a | ||
|
|
8995aa71f3 | ||
|
|
b32c80d0bb | ||
|
|
c28fa6b00c | ||
|
|
e041d6de8a | ||
|
|
7cdf6f1cc8 | ||
|
|
fb6a942954 | ||
|
|
ca74e2901d | ||
|
|
60ca33fecb | ||
|
|
fb6f00b90b | ||
|
|
dac4888f61 | ||
|
|
50faedad80 | ||
|
|
d5db73dbbf | ||
|
|
6da0d42e8d | ||
|
|
7060f55fdf | ||
|
|
2b729aaadc | ||
|
|
fa482cfd46 | ||
|
|
3972d847e6 | ||
|
|
82e0b04e4d | ||
|
|
7560af0955 | ||
|
|
5b6bc27cbe | ||
|
|
aeacdd9630 | ||
|
|
250cfe2b7f | ||
|
|
c43a282322 | ||
|
|
d090411207 | ||
|
|
077198f1a5 | ||
|
|
bccd31e327 | ||
|
|
cf2fb7cd3a | ||
|
|
f95489b8f2 | ||
|
|
961f71b971 | ||
|
|
547aca5af4 | ||
|
|
860f74b3c2 | ||
|
|
a86046b654 | ||
|
|
c061df8f06 | ||
|
|
a2e97dc936 | ||
|
|
e3e2857424 | ||
|
|
4f96a523da | ||
|
|
9e4f374811 | ||
|
|
7a0e274b20 | ||
|
|
2010cec78e | ||
|
|
0346b366ee | ||
|
|
ee06770742 | ||
|
|
a678ca3b60 | ||
|
|
36b56ad3a2 | ||
|
|
e14e1e3613 | ||
|
|
d17fc9aab3 | ||
|
|
5bf3b7f812 | ||
|
|
5de8f47138 | ||
|
|
4437583e3f | ||
|
|
76f3f9f17c | ||
|
|
1cb0630529 | ||
|
|
7aa8b6646e | ||
|
|
245dd5190e | ||
|
|
2f619f3ebd | ||
|
|
b658b4c8ef | ||
|
|
b621258ce7 | ||
|
|
827c0ef87b | ||
|
|
6b6f8967ac | ||
|
|
21be7f2908 | ||
|
|
f0fd11791c | ||
|
|
f6586ba8b4 | ||
|
|
63d5ed625d | ||
|
|
c2ca1677c8 | ||
|
|
b8479ebcb5 | ||
|
|
89fdc587e0 | ||
|
|
cf1fa981ef | ||
|
|
cef28ed3a0 | ||
|
|
205643ea14 | ||
|
|
fa58c5452a | ||
|
|
22c0e743f9 | ||
|
|
f4178f0472 | ||
|
|
e2b886bb64 | ||
|
|
a7bc40452f | ||
|
|
0aa40b8b21 | ||
|
|
dce9f0c9d5 | ||
|
|
b6805513f6 | ||
|
|
e0cace8a4d | ||
|
|
8d794da86c | ||
|
|
78b16ebcfa | ||
|
|
173b86de45 | ||
|
|
30d0bbca93 | ||
|
|
a9c8d300a5 | ||
|
|
6edc320b69 | ||
|
|
6ae19be4b7 | ||
|
|
6df421ad72 | ||
|
|
1e690a9e78 | ||
|
|
f05079bf98 | ||
|
|
d39e014533 | ||
|
|
75f5f4d88f | ||
|
|
a70f6e2d84 | ||
|
|
561ee5077e | ||
|
|
a9cc28f3b1 | ||
|
|
0b3090973e | ||
|
|
fba329438f | ||
|
|
c0b161602d | ||
|
|
2c83d2dbf6 | ||
|
|
5c8186f618 | ||
|
|
aecd72fa5c | ||
|
|
8756b6507b | ||
|
|
4b3caa5c18 | ||
|
|
da7da2fe75 | ||
|
|
e442b31203 | ||
|
|
ed6d680c70 | ||
|
|
ea709c2945 | ||
|
|
e7debe1a2c | ||
|
|
8bf3029d01 | ||
|
|
76bc617db9 | ||
|
|
cbaa117b8a | ||
|
|
ef52c8d507 | ||
|
|
f6fca1059d | ||
|
|
26d679e257 | ||
|
|
a14ad9bdd6 | ||
|
|
5388b8cd4b | ||
|
|
99427e741c | ||
|
|
33d029c1b0 | ||
|
|
949d62cc12 | ||
|
|
ef5b47b4f7 | ||
|
|
26c148510e | ||
|
|
1a6ce9436f | ||
|
|
1f0a5a9576 | ||
|
|
806939605a | ||
|
|
bd5f8f1b23 | ||
|
|
2c47ec7262 | ||
|
|
cff538114d | ||
|
|
1c8fc29c4a | ||
|
|
22fda7cedc | ||
|
|
b3674708d4 | ||
|
|
7a62c5d489 | ||
|
|
959cd272f7 | ||
|
|
8cd2b4ffd3 | ||
|
|
d5bdaf0c88 | ||
|
|
8f6e97633c | ||
|
|
4bd0ed3e83 | ||
|
|
6ede03c8ce | ||
|
|
dd6a97adfa | ||
|
|
ccf89378f8 | ||
|
|
8417d2a031 | ||
|
|
28dad7fca1 | ||
|
|
e94c364d65 | ||
|
|
29b854cf98 |
@@ -0,0 +1,2 @@
|
|||||||
|
# Ignore blame for commit that moved protolude files under src/protolude
|
||||||
|
d4949c633e8172d0e4dd8f5c991eaaae6b48fbb0
|
||||||
+5
-3
@@ -29,7 +29,8 @@ let
|
|||||||
|
|
||||||
# Format Haskell files
|
# Format Haskell files
|
||||||
# --vimgrep fixes a bug in ag: https://github.com/ggreer/the_silver_searcher/issues/753
|
# --vimgrep fixes a bug in ag: https://github.com/ggreer/the_silver_searcher/issues/753
|
||||||
${silver-searcher}/bin/ag -l --vimgrep -g '\.l?hs$' . \
|
# TODO: fix style issues in src/protolude and include it
|
||||||
|
${silver-searcher}/bin/ag -l --vimgrep -g '\.l?hs$' --ignore-dir=src/protolude . \
|
||||||
| xargs ${stylish-haskell}/bin/stylish-haskell -i
|
| xargs ${stylish-haskell}/bin/stylish-haskell -i
|
||||||
|
|
||||||
# Format Python files
|
# Format Python files
|
||||||
@@ -89,11 +90,12 @@ let
|
|||||||
${ruff}/bin/ruff check .
|
${ruff}/bin/ruff check .
|
||||||
|
|
||||||
echo "Checking consistency of import aliases in Haskell code..."
|
echo "Checking consistency of import aliases in Haskell code..."
|
||||||
${hsie} check-aliases main src
|
${hsie} check-aliases main src/PostgREST
|
||||||
|
|
||||||
echo "Linting Haskell files..."
|
echo "Linting Haskell files..."
|
||||||
# --vimgrep fixes a bug in ag: https://github.com/ggreer/the_silver_searcher/issues/753
|
# --vimgrep fixes a bug in ag: https://github.com/ggreer/the_silver_searcher/issues/753
|
||||||
${silver-searcher}/bin/ag -l --vimgrep -g '\.l?hs$' . \
|
# TODO: fix lint issues in src/protolude and include it
|
||||||
|
${silver-searcher}/bin/ag -l --vimgrep -g '\.l?hs$' --ignore-dir=src/protolude . \
|
||||||
| xargs ${hlint}/bin/hlint --hint=${hlintConfig}
|
| xargs ${hlint}/bin/hlint --hint=${hlintConfig}
|
||||||
'';
|
'';
|
||||||
|
|
||||||
|
|||||||
+53
-5
@@ -136,7 +136,7 @@ library
|
|||||||
, parsec >= 3.1.11 && < 3.2
|
, parsec >= 3.1.11 && < 3.2
|
||||||
, postgresql-libpq >= 0.10
|
, postgresql-libpq >= 0.10
|
||||||
, prometheus-client >= 1.1.1 && < 1.2.0
|
, prometheus-client >= 1.1.1 && < 1.2.0
|
||||||
, protolude >= 0.3.1 && < 0.4
|
, protolude
|
||||||
, regex-tdfa >= 1.2.2 && < 1.4
|
, regex-tdfa >= 1.2.2 && < 1.4
|
||||||
, retry >= 0.7.4 && < 0.10
|
, retry >= 0.7.4 && < 0.10
|
||||||
, scientific >= 0.3.4 && < 0.4
|
, scientific >= 0.3.4 && < 0.4
|
||||||
@@ -180,6 +180,54 @@ library
|
|||||||
build-depends:
|
build-depends:
|
||||||
unix
|
unix
|
||||||
|
|
||||||
|
library protolude
|
||||||
|
visibility: private
|
||||||
|
default-language: Haskell2010
|
||||||
|
default-extensions: NoImplicitPrelude
|
||||||
|
FlexibleContexts
|
||||||
|
MultiParamTypeClasses
|
||||||
|
OverloadedStrings
|
||||||
|
hs-source-dirs: src/protolude
|
||||||
|
exposed-modules: Protolude
|
||||||
|
Protolude.Applicative
|
||||||
|
Protolude.Base
|
||||||
|
Protolude.Bifunctor
|
||||||
|
Protolude.Bool
|
||||||
|
Protolude.CallStack
|
||||||
|
Protolude.Conv
|
||||||
|
Protolude.ConvertText
|
||||||
|
Protolude.Debug
|
||||||
|
Protolude.Either
|
||||||
|
Protolude.Error
|
||||||
|
Protolude.Exceptions
|
||||||
|
Protolude.Functor
|
||||||
|
Protolude.List
|
||||||
|
Protolude.Monad
|
||||||
|
Protolude.Panic
|
||||||
|
Protolude.Partial
|
||||||
|
Protolude.Safe
|
||||||
|
Protolude.Semiring
|
||||||
|
Protolude.Show
|
||||||
|
Protolude.Unsafe
|
||||||
|
build-depends: array >= 0.4 && < 0.6
|
||||||
|
, async >= 2.0 && < 2.3
|
||||||
|
, base >= 4.6 && < 4.22
|
||||||
|
, bytestring >= 0.10.8 && < 0.13
|
||||||
|
, containers >= 0.5.7 && < 0.8
|
||||||
|
, deepseq >= 1.3 && < 1.6
|
||||||
|
, ghc-prim >= 0.3 && < 0.14
|
||||||
|
, hashable >= 1.2 && < 1.6
|
||||||
|
, mtl >= 2.1 && < 2.4
|
||||||
|
, mtl-compat >= 0.2 && < 0.3
|
||||||
|
, stm >= 2.5 && < 3
|
||||||
|
, text >= 1.2.2 && < 2.2
|
||||||
|
, transformers >= 0.2 && < 0.7
|
||||||
|
, transformers-compat >= 0.4 && < 0.8
|
||||||
|
-- Protolude has some partial functions, so
|
||||||
|
-- it is fine to disable that specific warning
|
||||||
|
ghc-options: -Werror -Wall -fwarn-identities -Wno-x-partial
|
||||||
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
|
|
||||||
executable postgrest
|
executable postgrest
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions: OverloadedStrings
|
default-extensions: OverloadedStrings
|
||||||
@@ -189,7 +237,7 @@ executable postgrest
|
|||||||
build-depends: base >= 4.9 && < 4.22
|
build-depends: base >= 4.9 && < 4.22
|
||||||
, containers >= 0.5.7 && < 0.8
|
, containers >= 0.5.7 && < 0.8
|
||||||
, postgrest
|
, postgrest
|
||||||
, protolude >= 0.3.1 && < 0.4
|
, protolude
|
||||||
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -I0 -qg"
|
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -I0 -qg"
|
||||||
-O2 -Werror -Wall -fwarn-identities
|
-O2 -Werror -Wall -fwarn-identities
|
||||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
@@ -285,7 +333,7 @@ test-suite spec
|
|||||||
, postgrest
|
, postgrest
|
||||||
, process >= 1.4.2 && < 1.7
|
, process >= 1.4.2 && < 1.7
|
||||||
, prometheus-client >= 1.1.1 && < 1.2.0
|
, prometheus-client >= 1.1.1 && < 1.2.0
|
||||||
, protolude >= 0.3.1 && < 0.4
|
, protolude
|
||||||
, regex-tdfa >= 1.2.2 && < 1.4
|
, regex-tdfa >= 1.2.2 && < 1.4
|
||||||
, scientific >= 0.3.4 && < 0.4
|
, scientific >= 0.3.4 && < 0.4
|
||||||
, text >= 1.2.2 && < 2.2
|
, text >= 1.2.2 && < 2.2
|
||||||
@@ -324,7 +372,7 @@ test-suite observability
|
|||||||
, jose-jwt >= 0.9.6 && < 0.11
|
, jose-jwt >= 0.9.6 && < 0.11
|
||||||
, postgrest
|
, postgrest
|
||||||
, prometheus-client >= 1.1.1 && < 1.2.0
|
, prometheus-client >= 1.1.1 && < 1.2.0
|
||||||
, protolude >= 0.3.1 && < 0.4
|
, protolude
|
||||||
, text >= 1.2.2 && < 2.2
|
, text >= 1.2.2 && < 2.2
|
||||||
, wai >= 3.2.1 && < 3.3
|
, wai >= 3.2.1 && < 3.3
|
||||||
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
|
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
|
||||||
@@ -344,6 +392,6 @@ test-suite doctests
|
|||||||
, doctest >= 0.8
|
, doctest >= 0.8
|
||||||
, postgrest
|
, postgrest
|
||||||
, pretty-simple
|
, pretty-simple
|
||||||
, protolude >= 0.3.1 && < 0.4
|
, protolude
|
||||||
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
|
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
|
||||||
-fno-spec-constr -optP-Wno-nonportable-include-path
|
-fno-spec-constr -optP-Wno-nonportable-include-path
|
||||||
|
|||||||
@@ -0,0 +1,19 @@
|
|||||||
|
Copyright (c) 2016-2020, Stephen Diehl
|
||||||
|
|
||||||
|
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
of this software and associated documentation files (the "Software"), to
|
||||||
|
deal in the Software without restriction, including without limitation the
|
||||||
|
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
furnished to do so, subject to the following conditions:
|
||||||
|
|
||||||
|
The above copyright notice and this permission notice shall be included in
|
||||||
|
all copies or substantial portions of the Software.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
IN THE SOFTWARE.
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,38 @@
|
|||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Applicative
|
||||||
|
( orAlt,
|
||||||
|
orEmpty,
|
||||||
|
eitherA,
|
||||||
|
purer,
|
||||||
|
liftAA2,
|
||||||
|
(<<*>>),
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Data.Bool (Bool)
|
||||||
|
import Data.Either (Either (Left, Right))
|
||||||
|
import Data.Function ((.))
|
||||||
|
import Data.Monoid (Monoid (mempty))
|
||||||
|
|
||||||
|
orAlt :: (Alternative f, Monoid a) => f a -> f a
|
||||||
|
orAlt f = f <|> pure mempty
|
||||||
|
|
||||||
|
orEmpty :: Alternative f => Bool -> a -> f a
|
||||||
|
orEmpty b a = if b then pure a else empty
|
||||||
|
|
||||||
|
eitherA :: (Alternative f) => f a -> f b -> f (Either a b)
|
||||||
|
eitherA a b = (Left <$> a) <|> (Right <$> b)
|
||||||
|
|
||||||
|
purer :: (Applicative f, Applicative g) => a -> f (g a)
|
||||||
|
purer = pure . pure
|
||||||
|
|
||||||
|
liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c)
|
||||||
|
liftAA2 = liftA2 . liftA2
|
||||||
|
|
||||||
|
infixl 4 <<*>>
|
||||||
|
|
||||||
|
(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b)
|
||||||
|
(<<*>>) = liftA2 (<*>)
|
||||||
@@ -0,0 +1,225 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE MagicHash #-}
|
||||||
|
{-# LANGUAGE Unsafe #-}
|
||||||
|
{-# LANGUAGE BangPatterns #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE ExplicitNamespaces #-}
|
||||||
|
|
||||||
|
module Protolude.Base (
|
||||||
|
module Base,
|
||||||
|
($!),
|
||||||
|
) where
|
||||||
|
|
||||||
|
-- Glorious Glasgow Haskell Compiler
|
||||||
|
#if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 )
|
||||||
|
|
||||||
|
-- Base GHC types
|
||||||
|
import GHC.Num as Base (
|
||||||
|
Num(
|
||||||
|
(+),
|
||||||
|
(-),
|
||||||
|
(*),
|
||||||
|
negate,
|
||||||
|
abs,
|
||||||
|
signum,
|
||||||
|
fromInteger
|
||||||
|
)
|
||||||
|
, Integer
|
||||||
|
, subtract
|
||||||
|
)
|
||||||
|
import GHC.Enum as Base (
|
||||||
|
Bounded(minBound, maxBound)
|
||||||
|
, Enum(
|
||||||
|
succ,
|
||||||
|
pred,
|
||||||
|
toEnum,
|
||||||
|
fromEnum,
|
||||||
|
enumFrom,
|
||||||
|
enumFromThen,
|
||||||
|
enumFromTo,
|
||||||
|
enumFromThenTo
|
||||||
|
)
|
||||||
|
, boundedEnumFrom
|
||||||
|
, boundedEnumFromThen
|
||||||
|
)
|
||||||
|
import GHC.Real as Base (
|
||||||
|
(%)
|
||||||
|
, (/)
|
||||||
|
, Fractional
|
||||||
|
, Integral
|
||||||
|
, Ratio
|
||||||
|
, Rational
|
||||||
|
, Real
|
||||||
|
, RealFrac
|
||||||
|
, (^)
|
||||||
|
, (^%^)
|
||||||
|
, (^^)
|
||||||
|
, (^^%^^)
|
||||||
|
, ceiling
|
||||||
|
, denominator
|
||||||
|
, div
|
||||||
|
, divMod
|
||||||
|
#if MIN_VERSION_base(4,7,0)
|
||||||
|
, divZeroError
|
||||||
|
#endif
|
||||||
|
, even
|
||||||
|
, floor
|
||||||
|
, fromIntegral
|
||||||
|
, fromRational
|
||||||
|
, gcd
|
||||||
|
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,15,0)
|
||||||
|
#if defined(MIN_VERSION_integer_gmp)
|
||||||
|
, gcdInt'
|
||||||
|
, gcdWord'
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
, infinity
|
||||||
|
, integralEnumFrom
|
||||||
|
, integralEnumFromThen
|
||||||
|
, integralEnumFromThenTo
|
||||||
|
, integralEnumFromTo
|
||||||
|
, lcm
|
||||||
|
, mod
|
||||||
|
, notANumber
|
||||||
|
, numerator
|
||||||
|
, numericEnumFrom
|
||||||
|
, numericEnumFromThen
|
||||||
|
, numericEnumFromThenTo
|
||||||
|
, numericEnumFromTo
|
||||||
|
, odd
|
||||||
|
#if MIN_VERSION_base(4,7,0)
|
||||||
|
, overflowError
|
||||||
|
#endif
|
||||||
|
, properFraction
|
||||||
|
, quot
|
||||||
|
, quotRem
|
||||||
|
, ratioPrec
|
||||||
|
, ratioPrec1
|
||||||
|
#if MIN_VERSION_base(4,7,0)
|
||||||
|
, ratioZeroDenominatorError
|
||||||
|
#endif
|
||||||
|
, realToFrac
|
||||||
|
, recip
|
||||||
|
, reduce
|
||||||
|
, rem
|
||||||
|
, round
|
||||||
|
, showSigned
|
||||||
|
, toInteger
|
||||||
|
, toRational
|
||||||
|
, truncate
|
||||||
|
#if MIN_VERSION_base(4,12,0)
|
||||||
|
, underflowError
|
||||||
|
#endif
|
||||||
|
)
|
||||||
|
import GHC.Float as Base (
|
||||||
|
Float(F#)
|
||||||
|
, Double(D#)
|
||||||
|
, Floating (..)
|
||||||
|
, RealFloat(..)
|
||||||
|
, showFloat
|
||||||
|
, showSignedFloat
|
||||||
|
)
|
||||||
|
import GHC.Show as Base (
|
||||||
|
Show(showsPrec, show, showList)
|
||||||
|
)
|
||||||
|
import GHC.Exts as Base (
|
||||||
|
Constraint
|
||||||
|
, Ptr
|
||||||
|
, FunPtr
|
||||||
|
)
|
||||||
|
import GHC.Base as Base (
|
||||||
|
(++)
|
||||||
|
, seq
|
||||||
|
, asTypeOf
|
||||||
|
, ord
|
||||||
|
, maxInt
|
||||||
|
, minInt
|
||||||
|
, until
|
||||||
|
)
|
||||||
|
|
||||||
|
-- Exported for lifting into new functions.
|
||||||
|
import System.IO as Base (
|
||||||
|
print
|
||||||
|
, putStr
|
||||||
|
, putStrLn
|
||||||
|
)
|
||||||
|
|
||||||
|
import GHC.Types as Base (
|
||||||
|
Bool
|
||||||
|
, Char
|
||||||
|
, Int
|
||||||
|
, Word
|
||||||
|
, Ordering
|
||||||
|
, IO
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 710 )
|
||||||
|
, Coercible
|
||||||
|
#endif
|
||||||
|
)
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 710 )
|
||||||
|
import GHC.StaticPtr as Base (StaticPtr)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||||
|
import GHC.OverloadedLabels as Base (
|
||||||
|
IsLabel(fromLabel)
|
||||||
|
)
|
||||||
|
|
||||||
|
import GHC.ExecutionStack as Base (
|
||||||
|
Location(Location, srcLoc, objectName, functionName)
|
||||||
|
, SrcLoc(SrcLoc, sourceColumn, sourceLine, sourceColumn)
|
||||||
|
, getStackTrace
|
||||||
|
, showStackTrace
|
||||||
|
)
|
||||||
|
|
||||||
|
import GHC.Stack as Base (
|
||||||
|
CallStack
|
||||||
|
, type HasCallStack
|
||||||
|
, callStack
|
||||||
|
, prettySrcLoc
|
||||||
|
, currentCallStack
|
||||||
|
, getCallStack
|
||||||
|
, prettyCallStack
|
||||||
|
, withFrozenCallStack
|
||||||
|
)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 710 )
|
||||||
|
import GHC.TypeLits as Base (
|
||||||
|
Symbol
|
||||||
|
, SomeSymbol(SomeSymbol)
|
||||||
|
, Nat
|
||||||
|
, SomeNat(SomeNat)
|
||||||
|
, CmpNat
|
||||||
|
, KnownSymbol
|
||||||
|
, KnownNat
|
||||||
|
, natVal
|
||||||
|
, someNatVal
|
||||||
|
, symbolVal
|
||||||
|
, someSymbolVal
|
||||||
|
)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 802 )
|
||||||
|
import GHC.Records as Base (
|
||||||
|
HasField(getField)
|
||||||
|
)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||||
|
import Data.Kind as Base (
|
||||||
|
type Type
|
||||||
|
#if ( __GLASGOW_HASKELL__ < 805 )
|
||||||
|
, type (*)
|
||||||
|
#endif
|
||||||
|
, type Type
|
||||||
|
)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
-- Default Prelude defines this at the toplevel module, so we do as well.
|
||||||
|
infixr 0 $!
|
||||||
|
|
||||||
|
($!) :: (a -> b) -> a -> b
|
||||||
|
f $! x = let !vx = x in f vx
|
||||||
|
|
||||||
|
#endif
|
||||||
@@ -0,0 +1,51 @@
|
|||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Bifunctor
|
||||||
|
( Bifunctor,
|
||||||
|
bimap,
|
||||||
|
first,
|
||||||
|
second,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Applicative (Const (Const))
|
||||||
|
import Data.Either (Either (Left, Right))
|
||||||
|
import Data.Function ((.), id)
|
||||||
|
|
||||||
|
class Bifunctor p where
|
||||||
|
{-# MINIMAL bimap | first, second #-}
|
||||||
|
|
||||||
|
bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
|
||||||
|
bimap f g = first f . second g
|
||||||
|
|
||||||
|
first :: (a -> b) -> p a c -> p b c
|
||||||
|
first f = bimap f id
|
||||||
|
|
||||||
|
second :: (b -> c) -> p a b -> p a c
|
||||||
|
second = bimap id
|
||||||
|
|
||||||
|
instance Bifunctor (,) where
|
||||||
|
bimap f g ~(a, b) = (f a, g b)
|
||||||
|
|
||||||
|
instance Bifunctor ((,,) x1) where
|
||||||
|
bimap f g ~(x1, a, b) = (x1, f a, g b)
|
||||||
|
|
||||||
|
instance Bifunctor ((,,,) x1 x2) where
|
||||||
|
bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b)
|
||||||
|
|
||||||
|
instance Bifunctor ((,,,,) x1 x2 x3) where
|
||||||
|
bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b)
|
||||||
|
|
||||||
|
instance Bifunctor ((,,,,,) x1 x2 x3 x4) where
|
||||||
|
bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b)
|
||||||
|
|
||||||
|
instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where
|
||||||
|
bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)
|
||||||
|
|
||||||
|
instance Bifunctor Either where
|
||||||
|
bimap f _ (Left a) = Left (f a)
|
||||||
|
bimap _ g (Right b) = Right (g b)
|
||||||
|
|
||||||
|
instance Bifunctor Const where
|
||||||
|
bimap f _ (Const a) = Const (f a)
|
||||||
@@ -0,0 +1,64 @@
|
|||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Bool (
|
||||||
|
whenM
|
||||||
|
, unlessM
|
||||||
|
, ifM
|
||||||
|
, guardM
|
||||||
|
, bool
|
||||||
|
, (&&^)
|
||||||
|
, (||^)
|
||||||
|
, (<&&>)
|
||||||
|
, (<||>)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Bool (Bool(True, False), (&&), (||))
|
||||||
|
import Data.Function (flip)
|
||||||
|
import Control.Applicative(Applicative, liftA2)
|
||||||
|
import Control.Monad (Monad, MonadPlus, return, when, unless, guard, (>>=), (=<<))
|
||||||
|
|
||||||
|
bool :: a -> a -> Bool -> a
|
||||||
|
bool f t p = if p then t else f
|
||||||
|
|
||||||
|
whenM :: Monad m => m Bool -> m () -> m ()
|
||||||
|
whenM p m =
|
||||||
|
p >>= flip when m
|
||||||
|
|
||||||
|
unlessM :: Monad m => m Bool -> m () -> m ()
|
||||||
|
unlessM p m =
|
||||||
|
p >>= flip unless m
|
||||||
|
|
||||||
|
ifM :: Monad m => m Bool -> m a -> m a -> m a
|
||||||
|
ifM p x y = p >>= \b -> if b then x else y
|
||||||
|
|
||||||
|
guardM :: MonadPlus m => m Bool -> m ()
|
||||||
|
guardM f = guard =<< f
|
||||||
|
|
||||||
|
-- | The '||' operator lifted to a monad. If the first
|
||||||
|
-- argument evaluates to 'True' the second argument will not
|
||||||
|
-- be evaluated.
|
||||||
|
infixr 2 ||^ -- same as (||)
|
||||||
|
(||^) :: Monad m => m Bool -> m Bool -> m Bool
|
||||||
|
(||^) a b = ifM a (return True) b
|
||||||
|
|
||||||
|
infixr 2 <||>
|
||||||
|
-- | '||' lifted to an Applicative.
|
||||||
|
-- Unlike '||^' the operator is __not__ short-circuiting.
|
||||||
|
(<||>) :: Applicative a => a Bool -> a Bool -> a Bool
|
||||||
|
(<||>) = liftA2 (||)
|
||||||
|
{-# INLINE (<||>) #-}
|
||||||
|
|
||||||
|
-- | The '&&' operator lifted to a monad. If the first
|
||||||
|
-- argument evaluates to 'False' the second argument will not
|
||||||
|
-- be evaluated.
|
||||||
|
infixr 3 &&^ -- same as (&&)
|
||||||
|
(&&^) :: Monad m => m Bool -> m Bool -> m Bool
|
||||||
|
(&&^) a b = ifM a b (return False)
|
||||||
|
|
||||||
|
infixr 3 <&&>
|
||||||
|
-- | '&&' lifted to an Applicative.
|
||||||
|
-- Unlike '&&^' the operator is __not__ short-circuiting.
|
||||||
|
(<&&>) :: Applicative a => a Bool -> a Bool -> a Bool
|
||||||
|
(<&&>) = liftA2 (&&)
|
||||||
|
{-# INLINE (<&&>) #-}
|
||||||
@@ -0,0 +1,18 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE KindSignatures #-}
|
||||||
|
{-# LANGUAGE ImplicitParams #-}
|
||||||
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
|
|
||||||
|
module Protolude.CallStack
|
||||||
|
( HasCallStack
|
||||||
|
) where
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
import GHC.Stack (HasCallStack)
|
||||||
|
#elif MIN_VERSION_base(4,8,1)
|
||||||
|
import qualified GHC.Stack
|
||||||
|
type HasCallStack = (?callStack :: GHC.Stack.CallStack)
|
||||||
|
#else
|
||||||
|
import GHC.Exts (Constraint)
|
||||||
|
type HasCallStack = (() :: Constraint)
|
||||||
|
#endif
|
||||||
@@ -0,0 +1,78 @@
|
|||||||
|
{-# LANGUAGE Trustworthy #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
|
|
||||||
|
-- | An alternative to 'Protolude.ConvertText' that includes
|
||||||
|
-- partial conversions. Not re-exported by 'Protolude'.
|
||||||
|
module Protolude.Conv (
|
||||||
|
StringConv
|
||||||
|
, strConv
|
||||||
|
, toS
|
||||||
|
, toSL
|
||||||
|
, Leniency (Lenient, Strict)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.ByteString.Char8 as B
|
||||||
|
import Data.ByteString.Lazy.Char8 as LB
|
||||||
|
import Data.Text as T
|
||||||
|
import Data.Text.Encoding as T
|
||||||
|
import Data.Text.Encoding.Error as T
|
||||||
|
import Data.Text.Lazy as LT
|
||||||
|
import Data.Text.Lazy.Encoding as LT
|
||||||
|
|
||||||
|
import Protolude.Base
|
||||||
|
import Data.Eq (Eq)
|
||||||
|
import Data.Ord (Ord)
|
||||||
|
import Data.Function ((.), id)
|
||||||
|
import Data.String (String)
|
||||||
|
import Control.Applicative (pure)
|
||||||
|
|
||||||
|
data Leniency = Lenient | Strict
|
||||||
|
deriving (Eq,Show,Ord,Enum,Bounded)
|
||||||
|
|
||||||
|
class StringConv a b where
|
||||||
|
strConv :: Leniency -> a -> b
|
||||||
|
|
||||||
|
toS :: StringConv a b => a -> b
|
||||||
|
toS = strConv Strict
|
||||||
|
|
||||||
|
toSL :: StringConv a b => a -> b
|
||||||
|
toSL = strConv Lenient
|
||||||
|
|
||||||
|
instance StringConv String String where strConv _ = id
|
||||||
|
instance StringConv String B.ByteString where strConv _ = B.pack
|
||||||
|
instance StringConv String LB.ByteString where strConv _ = LB.pack
|
||||||
|
instance StringConv String T.Text where strConv _ = T.pack
|
||||||
|
instance StringConv String LT.Text where strConv _ = LT.pack
|
||||||
|
|
||||||
|
instance StringConv B.ByteString String where strConv _ = B.unpack
|
||||||
|
instance StringConv B.ByteString B.ByteString where strConv _ = id
|
||||||
|
instance StringConv B.ByteString LB.ByteString where strConv _ = LB.fromChunks . pure
|
||||||
|
instance StringConv B.ByteString T.Text where strConv = decodeUtf8T
|
||||||
|
instance StringConv B.ByteString LT.Text where strConv l = strConv l . LB.fromChunks . pure
|
||||||
|
|
||||||
|
instance StringConv LB.ByteString String where strConv _ = LB.unpack
|
||||||
|
instance StringConv LB.ByteString B.ByteString where strConv _ = B.concat . LB.toChunks
|
||||||
|
instance StringConv LB.ByteString LB.ByteString where strConv _ = id
|
||||||
|
instance StringConv LB.ByteString T.Text where strConv l = decodeUtf8T l . strConv l
|
||||||
|
instance StringConv LB.ByteString LT.Text where strConv = decodeUtf8LT
|
||||||
|
|
||||||
|
instance StringConv T.Text String where strConv _ = T.unpack
|
||||||
|
instance StringConv T.Text B.ByteString where strConv _ = T.encodeUtf8
|
||||||
|
instance StringConv T.Text LB.ByteString where strConv l = strConv l . T.encodeUtf8
|
||||||
|
instance StringConv T.Text LT.Text where strConv _ = LT.fromStrict
|
||||||
|
instance StringConv T.Text T.Text where strConv _ = id
|
||||||
|
|
||||||
|
instance StringConv LT.Text String where strConv _ = LT.unpack
|
||||||
|
instance StringConv LT.Text T.Text where strConv _ = LT.toStrict
|
||||||
|
instance StringConv LT.Text LT.Text where strConv _ = id
|
||||||
|
instance StringConv LT.Text LB.ByteString where strConv _ = LT.encodeUtf8
|
||||||
|
instance StringConv LT.Text B.ByteString where strConv l = strConv l . LT.encodeUtf8
|
||||||
|
|
||||||
|
decodeUtf8T :: Leniency -> B.ByteString -> T.Text
|
||||||
|
decodeUtf8T Lenient = T.decodeUtf8With T.lenientDecode
|
||||||
|
decodeUtf8T Strict = T.decodeUtf8With T.strictDecode
|
||||||
|
|
||||||
|
decodeUtf8LT :: Leniency -> LB.ByteString -> LT.Text
|
||||||
|
decodeUtf8LT Lenient = LT.decodeUtf8With T.lenientDecode
|
||||||
|
decodeUtf8LT Strict = LT.decodeUtf8With T.strictDecode
|
||||||
@@ -0,0 +1,50 @@
|
|||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
|
||||||
|
-- | Non-partial text conversion typeclass and functions.
|
||||||
|
-- For an alternative with partial conversions import 'Protolude.Conv'.
|
||||||
|
module Protolude.ConvertText (
|
||||||
|
ConvertText (toS)
|
||||||
|
, toUtf8
|
||||||
|
, toUtf8Lazy
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.ByteString as B
|
||||||
|
import qualified Data.ByteString.Lazy as LB
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Lazy as LT
|
||||||
|
|
||||||
|
import Data.Function (id, (.))
|
||||||
|
import Data.String (String)
|
||||||
|
import Data.Text.Encoding (encodeUtf8)
|
||||||
|
|
||||||
|
-- | Convert from one Unicode textual type to another. Not for serialization/deserialization,
|
||||||
|
-- so doesn't have instances for bytestrings.
|
||||||
|
class ConvertText a b where
|
||||||
|
toS :: a -> b
|
||||||
|
|
||||||
|
instance ConvertText String String where toS = id
|
||||||
|
instance ConvertText String T.Text where toS = T.pack
|
||||||
|
instance ConvertText String LT.Text where toS = LT.pack
|
||||||
|
|
||||||
|
instance ConvertText T.Text String where toS = T.unpack
|
||||||
|
instance ConvertText T.Text LT.Text where toS = LT.fromStrict
|
||||||
|
instance ConvertText T.Text T.Text where toS = id
|
||||||
|
|
||||||
|
instance ConvertText LT.Text String where toS = LT.unpack
|
||||||
|
instance ConvertText LT.Text T.Text where toS = LT.toStrict
|
||||||
|
instance ConvertText LT.Text LT.Text where toS = id
|
||||||
|
|
||||||
|
instance ConvertText LB.ByteString B.ByteString where toS = LB.toStrict
|
||||||
|
instance ConvertText LB.ByteString LB.ByteString where toS = id
|
||||||
|
|
||||||
|
instance ConvertText B.ByteString B.ByteString where toS = id
|
||||||
|
instance ConvertText B.ByteString LB.ByteString where toS = LB.fromStrict
|
||||||
|
|
||||||
|
toUtf8 :: ConvertText a T.Text => a -> B.ByteString
|
||||||
|
toUtf8 =
|
||||||
|
encodeUtf8 . toS
|
||||||
|
|
||||||
|
toUtf8Lazy :: ConvertText a T.Text => a -> LB.ByteString
|
||||||
|
toUtf8Lazy =
|
||||||
|
LB.fromStrict . encodeUtf8 . toS
|
||||||
@@ -0,0 +1,69 @@
|
|||||||
|
{-# LANGUAGE Trustworthy #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
|
||||||
|
|
||||||
|
module Protolude.Debug (
|
||||||
|
undefined,
|
||||||
|
trace,
|
||||||
|
traceM,
|
||||||
|
traceId,
|
||||||
|
traceIO,
|
||||||
|
traceShow,
|
||||||
|
traceShowId,
|
||||||
|
traceShowM,
|
||||||
|
notImplemented,
|
||||||
|
witness,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Text (Text, unpack)
|
||||||
|
import Control.Monad (Monad, return)
|
||||||
|
|
||||||
|
import qualified Protolude.Base as P
|
||||||
|
import Protolude.Error (error)
|
||||||
|
import Protolude.Show (Print, hPutStrLn)
|
||||||
|
|
||||||
|
import System.IO(stderr)
|
||||||
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
|
||||||
|
{-# WARNING trace "'trace' remains in code" #-}
|
||||||
|
trace :: Print b => b -> a -> a
|
||||||
|
trace string expr = unsafePerformIO (do
|
||||||
|
hPutStrLn stderr string
|
||||||
|
return expr)
|
||||||
|
|
||||||
|
{-# WARNING traceIO "'traceIO' remains in code" #-}
|
||||||
|
traceIO :: Print b => b -> a -> P.IO a
|
||||||
|
traceIO string expr = do
|
||||||
|
hPutStrLn stderr string
|
||||||
|
return expr
|
||||||
|
|
||||||
|
{-# WARNING traceShow "'traceShow' remains in code" #-}
|
||||||
|
traceShow :: P.Show a => a -> b -> b
|
||||||
|
traceShow a b = trace (P.show a) b
|
||||||
|
|
||||||
|
{-# WARNING traceShowId "'traceShowId' remains in code" #-}
|
||||||
|
traceShowId :: P.Show a => a -> a
|
||||||
|
traceShowId a = trace (P.show a) a
|
||||||
|
|
||||||
|
{-# WARNING traceShowM "'traceShowM' remains in code" #-}
|
||||||
|
traceShowM :: (P.Show a, Monad m) => a -> m ()
|
||||||
|
traceShowM a = trace (P.show a) (return ())
|
||||||
|
|
||||||
|
{-# WARNING traceM "'traceM' remains in code" #-}
|
||||||
|
traceM :: (Monad m) => Text -> m ()
|
||||||
|
traceM s = trace (unpack s) (return ())
|
||||||
|
|
||||||
|
{-# WARNING traceId "'traceId' remains in code" #-}
|
||||||
|
traceId :: Text -> Text
|
||||||
|
traceId s = trace s s
|
||||||
|
|
||||||
|
{-# WARNING notImplemented "'notImplemented' remains in code" #-}
|
||||||
|
notImplemented :: a
|
||||||
|
notImplemented = error "Not implemented"
|
||||||
|
|
||||||
|
{-# WARNING undefined "'undefined' remains in code" #-}
|
||||||
|
undefined :: a
|
||||||
|
undefined = error "Prelude.undefined"
|
||||||
|
|
||||||
|
witness :: a
|
||||||
|
witness = error "Type witness should not be evaluated"
|
||||||
@@ -0,0 +1,51 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Either (
|
||||||
|
maybeToLeft
|
||||||
|
, maybeToRight
|
||||||
|
, leftToMaybe
|
||||||
|
, rightToMaybe
|
||||||
|
, maybeEmpty
|
||||||
|
, maybeToEither
|
||||||
|
, fromLeft
|
||||||
|
, fromRight
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Function (const)
|
||||||
|
import Data.Monoid (Monoid, mempty)
|
||||||
|
import Data.Maybe (Maybe(Nothing, Just), maybe)
|
||||||
|
import Data.Either (Either(Left, Right), either)
|
||||||
|
#if MIN_VERSION_base(4,10,0)
|
||||||
|
import Data.Either (fromLeft, fromRight)
|
||||||
|
#else
|
||||||
|
-- | Return the contents of a 'Right'-value or a default value otherwise.
|
||||||
|
fromLeft :: a -> Either a b -> a
|
||||||
|
fromLeft _ (Left a) = a
|
||||||
|
fromLeft a _ = a
|
||||||
|
|
||||||
|
-- | Return the contents of a 'Right'-value or a default value otherwise.
|
||||||
|
fromRight :: b -> Either a b -> b
|
||||||
|
fromRight _ (Right b) = b
|
||||||
|
fromRight b _ = b
|
||||||
|
#endif
|
||||||
|
|
||||||
|
leftToMaybe :: Either l r -> Maybe l
|
||||||
|
leftToMaybe = either Just (const Nothing)
|
||||||
|
|
||||||
|
rightToMaybe :: Either l r -> Maybe r
|
||||||
|
rightToMaybe = either (const Nothing) Just
|
||||||
|
|
||||||
|
maybeToRight :: l -> Maybe r -> Either l r
|
||||||
|
maybeToRight l = maybe (Left l) Right
|
||||||
|
|
||||||
|
maybeToLeft :: r -> Maybe l -> Either l r
|
||||||
|
maybeToLeft r = maybe (Right r) Left
|
||||||
|
|
||||||
|
maybeEmpty :: Monoid b => (a -> b) -> Maybe a -> b
|
||||||
|
maybeEmpty = maybe mempty
|
||||||
|
|
||||||
|
maybeToEither :: e -> Maybe a -> Either e a
|
||||||
|
maybeToEither e Nothing = Left e
|
||||||
|
maybeToEither _ (Just a) = Right a
|
||||||
@@ -0,0 +1,52 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE PolyKinds #-}
|
||||||
|
{-# LANGUAGE MagicHash #-}
|
||||||
|
{-# LANGUAGE ImplicitParams #-}
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
module Protolude.Error
|
||||||
|
( error
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Text (Text, unpack)
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
-- Full stack trace.
|
||||||
|
|
||||||
|
import GHC.Prim (TYPE, raise#)
|
||||||
|
import GHC.Types (RuntimeRep)
|
||||||
|
import Protolude.CallStack (HasCallStack)
|
||||||
|
import GHC.Exception (errorCallWithCallStackException)
|
||||||
|
|
||||||
|
{-# WARNING error "'error' remains in code" #-}
|
||||||
|
error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => Text -> a
|
||||||
|
error s = raise# (errorCallWithCallStackException (unpack s) ?callStack)
|
||||||
|
|
||||||
|
#elif MIN_VERSION_base(4,7,0)
|
||||||
|
-- Basic Call Stack with callsite.
|
||||||
|
|
||||||
|
import GHC.Prim (raise#)
|
||||||
|
import GHC.Exception (errorCallException)
|
||||||
|
|
||||||
|
{-# WARNING error "'error' remains in code" #-}
|
||||||
|
error :: Text -> a
|
||||||
|
error s = raise# (errorCallException (unpack s))
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
|
-- No exception tracing.
|
||||||
|
import GHC.Types
|
||||||
|
import GHC.Exception
|
||||||
|
|
||||||
|
{-# WARNING error "'error' remains in code" #-}
|
||||||
|
error :: Text -> a
|
||||||
|
error s = throw (ErrorCall (unpack s))
|
||||||
|
|
||||||
|
#endif
|
||||||
@@ -0,0 +1,35 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE Trustworthy #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Exceptions (
|
||||||
|
hush,
|
||||||
|
note,
|
||||||
|
tryIO,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude.Base (IO)
|
||||||
|
import Data.Function ((.))
|
||||||
|
import Control.Monad.Trans (liftIO)
|
||||||
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
|
import Control.Monad.Except (ExceptT(ExceptT), MonadError, throwError)
|
||||||
|
import Control.Exception as Exception
|
||||||
|
import Control.Applicative
|
||||||
|
import Data.Maybe (Maybe, maybe)
|
||||||
|
import Data.Either (Either(Left,Right))
|
||||||
|
|
||||||
|
hush :: Alternative m => Either e a -> m a
|
||||||
|
hush (Left _) = empty
|
||||||
|
hush (Right x) = pure x
|
||||||
|
|
||||||
|
-- To suppress redundant applicative constraint warning on GHC 8.0
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||||
|
note :: (MonadError e m) => e -> Maybe a -> m a
|
||||||
|
note err = maybe (throwError err) pure
|
||||||
|
#else
|
||||||
|
note :: (MonadError e m, Applicative m) => e -> Maybe a -> m a
|
||||||
|
note err = maybe (throwError err) pure
|
||||||
|
#endif
|
||||||
|
|
||||||
|
tryIO :: MonadIO m => IO a -> ExceptT IOException m a
|
||||||
|
tryIO = ExceptT . liftIO . Exception.try
|
||||||
@@ -0,0 +1,62 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Functor (
|
||||||
|
Functor(fmap),
|
||||||
|
($>),
|
||||||
|
(<$),
|
||||||
|
(<$>),
|
||||||
|
(<<$>>),
|
||||||
|
(<&>),
|
||||||
|
void,
|
||||||
|
foreach,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Function ((.), flip)
|
||||||
|
#if MIN_VERSION_base(4,11,0)
|
||||||
|
import Data.Functor ((<&>))
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,7,0)
|
||||||
|
import Data.Functor (
|
||||||
|
Functor(fmap)
|
||||||
|
, (<$)
|
||||||
|
, ($>)
|
||||||
|
, (<$>)
|
||||||
|
, void
|
||||||
|
)
|
||||||
|
#else
|
||||||
|
import Data.Functor (
|
||||||
|
Functor(fmap)
|
||||||
|
, (<$)
|
||||||
|
, (<$>)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
infixl 4 $>
|
||||||
|
|
||||||
|
($>) :: Functor f => f a -> b -> f b
|
||||||
|
($>) = flip (<$)
|
||||||
|
|
||||||
|
void :: Functor f => f a -> f ()
|
||||||
|
void x = () <$ x
|
||||||
|
#endif
|
||||||
|
|
||||||
|
infixl 4 <<$>>
|
||||||
|
|
||||||
|
(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
|
||||||
|
(<<$>>) = fmap . fmap
|
||||||
|
|
||||||
|
foreach :: Functor f => f a -> (a -> b) -> f b
|
||||||
|
foreach = flip fmap
|
||||||
|
|
||||||
|
#if !MIN_VERSION_base(4,11,0)
|
||||||
|
-- | Infix version of foreach.
|
||||||
|
--
|
||||||
|
-- '<&>' is to '<$>' what '&' is to '$'.
|
||||||
|
|
||||||
|
infixl 1 <&>
|
||||||
|
(<&>) :: Functor f => f a -> (a -> b) -> f b
|
||||||
|
(<&>) = foreach
|
||||||
|
#endif
|
||||||
@@ -0,0 +1,52 @@
|
|||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
|
||||||
|
module Protolude.List
|
||||||
|
( head,
|
||||||
|
ordNub,
|
||||||
|
sortOn,
|
||||||
|
list,
|
||||||
|
product,
|
||||||
|
sum,
|
||||||
|
groupBy,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Applicative (pure)
|
||||||
|
import Data.Foldable (Foldable, foldl', foldr)
|
||||||
|
import Data.Function ((.))
|
||||||
|
import Data.Functor (fmap)
|
||||||
|
import Data.List (groupBy, sortBy)
|
||||||
|
import Data.Maybe (Maybe (Nothing))
|
||||||
|
import Data.Ord (Ord, comparing)
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
import Prelude ((*), (+), Num)
|
||||||
|
|
||||||
|
head :: (Foldable f) => f a -> Maybe a
|
||||||
|
head = foldr (\x _ -> pure x) Nothing
|
||||||
|
|
||||||
|
sortOn :: (Ord o) => (a -> o) -> [a] -> [a]
|
||||||
|
sortOn = sortBy . comparing
|
||||||
|
|
||||||
|
-- O(n * log n)
|
||||||
|
ordNub :: (Ord a) => [a] -> [a]
|
||||||
|
ordNub l = go Set.empty l
|
||||||
|
where
|
||||||
|
go _ [] = []
|
||||||
|
go s (x : xs) =
|
||||||
|
if x `Set.member` s
|
||||||
|
then go s xs
|
||||||
|
else x : go (Set.insert x s) xs
|
||||||
|
|
||||||
|
list :: [b] -> (a -> b) -> [a] -> [b]
|
||||||
|
list def f xs = case xs of
|
||||||
|
[] -> def
|
||||||
|
_ -> fmap f xs
|
||||||
|
|
||||||
|
{-# INLINE product #-}
|
||||||
|
product :: (Foldable f, Num a) => f a -> a
|
||||||
|
product = foldl' (*) 1
|
||||||
|
|
||||||
|
{-# INLINE sum #-}
|
||||||
|
sum :: (Foldable f, Num a) => f a -> a
|
||||||
|
sum = foldl' (+) 0
|
||||||
@@ -0,0 +1,69 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE Trustworthy #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Monad (
|
||||||
|
Monad((>>=), return)
|
||||||
|
, MonadPlus(mzero, mplus)
|
||||||
|
|
||||||
|
, (=<<)
|
||||||
|
, (>=>)
|
||||||
|
, (<=<)
|
||||||
|
, (>>)
|
||||||
|
, forever
|
||||||
|
|
||||||
|
, join
|
||||||
|
, mfilter
|
||||||
|
, filterM
|
||||||
|
, mapAndUnzipM
|
||||||
|
, zipWithM
|
||||||
|
, zipWithM_
|
||||||
|
, foldM
|
||||||
|
, foldM_
|
||||||
|
, replicateM
|
||||||
|
, replicateM_
|
||||||
|
, concatMapM
|
||||||
|
|
||||||
|
, guard
|
||||||
|
, when
|
||||||
|
, unless
|
||||||
|
|
||||||
|
, liftM
|
||||||
|
, liftM2
|
||||||
|
, liftM3
|
||||||
|
, liftM4
|
||||||
|
, liftM5
|
||||||
|
, liftM'
|
||||||
|
, liftM2'
|
||||||
|
, ap
|
||||||
|
|
||||||
|
, (<$!>)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude.Base (seq)
|
||||||
|
import Data.List (concat)
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
|
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
|
||||||
|
concatMapM f xs = liftM concat (mapM f xs)
|
||||||
|
|
||||||
|
liftM' :: Monad m => (a -> b) -> m a -> m b
|
||||||
|
liftM' = (<$!>)
|
||||||
|
{-# INLINE liftM' #-}
|
||||||
|
|
||||||
|
liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
|
||||||
|
liftM2' f a b = do
|
||||||
|
x <- a
|
||||||
|
y <- b
|
||||||
|
let z = f x y
|
||||||
|
z `seq` return z
|
||||||
|
{-# INLINE liftM2' #-}
|
||||||
|
|
||||||
|
#if !MIN_VERSION_base(4,8,0)
|
||||||
|
(<$!>) :: Monad m => (a -> b) -> m a -> m b
|
||||||
|
f <$!> m = do
|
||||||
|
x <- m
|
||||||
|
let z = f x
|
||||||
|
z `seq` return z
|
||||||
|
{-# INLINE (<$!>) #-}
|
||||||
|
#endif
|
||||||
@@ -0,0 +1,26 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE Trustworthy #-}
|
||||||
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
module Protolude.Panic (
|
||||||
|
FatalError(FatalError, fatalErrorMessage),
|
||||||
|
panic,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude.Base (Show)
|
||||||
|
import Protolude.CallStack (HasCallStack)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Control.Exception as X
|
||||||
|
|
||||||
|
-- | Uncatchable exceptions thrown and never caught.
|
||||||
|
newtype FatalError = FatalError { fatalErrorMessage :: Text }
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
instance Exception FatalError
|
||||||
|
|
||||||
|
panic :: HasCallStack => Text -> a
|
||||||
|
panic a = throw (FatalError a)
|
||||||
@@ -0,0 +1,26 @@
|
|||||||
|
module Protolude.Partial
|
||||||
|
( head,
|
||||||
|
init,
|
||||||
|
tail,
|
||||||
|
last,
|
||||||
|
foldl,
|
||||||
|
foldr,
|
||||||
|
foldl',
|
||||||
|
foldr',
|
||||||
|
foldr1,
|
||||||
|
foldl1,
|
||||||
|
cycle,
|
||||||
|
maximum,
|
||||||
|
minimum,
|
||||||
|
(!!),
|
||||||
|
sum,
|
||||||
|
product,
|
||||||
|
fromJust,
|
||||||
|
read,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Foldable (foldl, foldl', foldl1, foldr, foldr', foldr1, product, sum)
|
||||||
|
import Data.List ((!!), cycle, head, init, last, maximum, minimum, tail)
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
import Text.Read (read)
|
||||||
@@ -0,0 +1,137 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Safe (
|
||||||
|
headMay
|
||||||
|
, headDef
|
||||||
|
, initMay
|
||||||
|
, initDef
|
||||||
|
, initSafe
|
||||||
|
, tailMay
|
||||||
|
, tailDef
|
||||||
|
, tailSafe
|
||||||
|
, lastDef
|
||||||
|
, lastMay
|
||||||
|
, foldr1May
|
||||||
|
, foldl1May
|
||||||
|
, foldl1May'
|
||||||
|
, maximumMay
|
||||||
|
, minimumMay
|
||||||
|
, maximumDef
|
||||||
|
, minimumDef
|
||||||
|
, atMay
|
||||||
|
, atDef
|
||||||
|
) where
|
||||||
|
|
||||||
|
|
||||||
|
import Data.Ord (Ord, (<))
|
||||||
|
import Data.Int (Int)
|
||||||
|
import Data.Char (Char)
|
||||||
|
import Data.Bool (Bool, otherwise)
|
||||||
|
import Data.Maybe (Maybe(Nothing, Just), fromMaybe)
|
||||||
|
import Data.Either (Either(Left, Right))
|
||||||
|
import Data.Function ((.))
|
||||||
|
import Data.List (null, head, last, tail, init, maximum, minimum, foldr1, foldl1, foldl1', (++))
|
||||||
|
|
||||||
|
import Prelude ((-))
|
||||||
|
import GHC.Show (show)
|
||||||
|
|
||||||
|
liftMay :: (a -> Bool) -> (a -> b) -> (a -> Maybe b)
|
||||||
|
liftMay test f val = if test val then Nothing else Just (f val)
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Head
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
headMay :: [a] -> Maybe a
|
||||||
|
headMay = liftMay null head
|
||||||
|
|
||||||
|
headDef :: a -> [a] -> a
|
||||||
|
headDef def = fromMaybe def . headMay
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Init
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
initMay :: [a] -> Maybe [a]
|
||||||
|
initMay = liftMay null init
|
||||||
|
|
||||||
|
initDef :: [a] -> [a] -> [a]
|
||||||
|
initDef def = fromMaybe def . initMay
|
||||||
|
|
||||||
|
initSafe :: [a] -> [a]
|
||||||
|
initSafe = initDef []
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Tail
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
tailMay :: [a] -> Maybe [a]
|
||||||
|
tailMay = liftMay null tail
|
||||||
|
|
||||||
|
tailDef :: [a] -> [a] -> [a]
|
||||||
|
tailDef def = fromMaybe def . tailMay
|
||||||
|
|
||||||
|
tailSafe :: [a] -> [a]
|
||||||
|
tailSafe = tailDef []
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Last
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
lastMay :: [a] -> Maybe a
|
||||||
|
lastMay = liftMay null last
|
||||||
|
|
||||||
|
lastDef :: a -> [a] -> a
|
||||||
|
lastDef def = fromMaybe def . lastMay
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Maximum
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
minimumMay, maximumMay :: Ord a => [a] -> Maybe a
|
||||||
|
minimumMay = liftMay null minimum
|
||||||
|
maximumMay = liftMay null maximum
|
||||||
|
|
||||||
|
minimumDef, maximumDef :: Ord a => a -> [a] -> a
|
||||||
|
minimumDef def = fromMaybe def . minimumMay
|
||||||
|
maximumDef def = fromMaybe def . maximumMay
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Foldr
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a
|
||||||
|
foldr1May = liftMay null . foldr1
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Foldl
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
foldl1May = liftMay null . foldl1
|
||||||
|
foldl1May' = liftMay null . foldl1'
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- At
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
at_ :: [a] -> Int -> Either [Char] a
|
||||||
|
at_ ys o
|
||||||
|
| o < 0 = Left ("index must not be negative, index=" ++ show o)
|
||||||
|
| otherwise = f o ys
|
||||||
|
where
|
||||||
|
f 0 (x:_) = Right x
|
||||||
|
f i (_:xs) = f (i-1) xs
|
||||||
|
f i [] = Left ("index too large, index=" ++ show o ++ ", length=" ++ show (o-i))
|
||||||
|
|
||||||
|
atMay :: [a] -> Int -> Maybe a
|
||||||
|
atMay xs i = case xs `at_` i of
|
||||||
|
Left _ -> Nothing
|
||||||
|
Right val -> Just val
|
||||||
|
|
||||||
|
atDef :: a -> [a] -> Int -> a
|
||||||
|
atDef def xs i = case xs `at_` i of
|
||||||
|
Left _ -> def
|
||||||
|
Right val -> val
|
||||||
@@ -0,0 +1,22 @@
|
|||||||
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Semiring
|
||||||
|
( Semiring,
|
||||||
|
one,
|
||||||
|
(<.>),
|
||||||
|
zero,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Monoid
|
||||||
|
|
||||||
|
-- | Alias for 'mempty'
|
||||||
|
zero :: Monoid m => m
|
||||||
|
zero = mempty
|
||||||
|
|
||||||
|
class Monoid m => Semiring m where
|
||||||
|
{-# MINIMAL one, (<.>) #-}
|
||||||
|
|
||||||
|
one :: m
|
||||||
|
(<.>) :: m -> m -> m
|
||||||
@@ -0,0 +1,83 @@
|
|||||||
|
{-# LANGUAGE ExtendedDefaultRules #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE Trustworthy #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Show
|
||||||
|
( Print,
|
||||||
|
hPutStr,
|
||||||
|
putStr,
|
||||||
|
hPutStrLn,
|
||||||
|
putStrLn,
|
||||||
|
putErrLn,
|
||||||
|
putText,
|
||||||
|
putErrText,
|
||||||
|
putLText,
|
||||||
|
putByteString,
|
||||||
|
putLByteString,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as BL
|
||||||
|
import Data.Function ((.))
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.IO as T
|
||||||
|
import qualified Data.Text.Lazy as TL
|
||||||
|
import qualified Data.Text.Lazy.IO as TL
|
||||||
|
import qualified Protolude.Base as Base
|
||||||
|
import qualified System.IO as Base
|
||||||
|
import System.IO (Handle, stderr, stdout)
|
||||||
|
|
||||||
|
class Print a where
|
||||||
|
hPutStr :: MonadIO m => Handle -> a -> m ()
|
||||||
|
putStr :: MonadIO m => a -> m ()
|
||||||
|
putStr = hPutStr stdout
|
||||||
|
hPutStrLn :: MonadIO m => Handle -> a -> m ()
|
||||||
|
putStrLn :: MonadIO m => a -> m ()
|
||||||
|
putStrLn = hPutStrLn stdout
|
||||||
|
putErrLn :: MonadIO m => a -> m ()
|
||||||
|
putErrLn = hPutStrLn stderr
|
||||||
|
|
||||||
|
instance Print T.Text where
|
||||||
|
hPutStr = \h -> liftIO . T.hPutStr h
|
||||||
|
hPutStrLn = \h -> liftIO . T.hPutStrLn h
|
||||||
|
|
||||||
|
instance Print TL.Text where
|
||||||
|
hPutStr = \h -> liftIO . TL.hPutStr h
|
||||||
|
hPutStrLn = \h -> liftIO . TL.hPutStrLn h
|
||||||
|
|
||||||
|
instance Print BS.ByteString where
|
||||||
|
hPutStr = \h -> liftIO . BS.hPutStr h
|
||||||
|
hPutStrLn = \h -> liftIO . BS.hPutStrLn h
|
||||||
|
|
||||||
|
instance Print BL.ByteString where
|
||||||
|
hPutStr = \h -> liftIO . BL.hPutStr h
|
||||||
|
hPutStrLn = \h -> liftIO . BL.hPutStrLn h
|
||||||
|
|
||||||
|
instance Print [Base.Char] where
|
||||||
|
hPutStr = \h -> liftIO . Base.hPutStr h
|
||||||
|
hPutStrLn = \h -> liftIO . Base.hPutStrLn h
|
||||||
|
|
||||||
|
-- For forcing type inference
|
||||||
|
putText :: MonadIO m => T.Text -> m ()
|
||||||
|
putText = putStrLn
|
||||||
|
{-# SPECIALIZE putText :: T.Text -> Base.IO () #-}
|
||||||
|
|
||||||
|
putLText :: MonadIO m => TL.Text -> m ()
|
||||||
|
putLText = putStrLn
|
||||||
|
{-# SPECIALIZE putLText :: TL.Text -> Base.IO () #-}
|
||||||
|
|
||||||
|
putByteString :: MonadIO m => BS.ByteString -> m ()
|
||||||
|
putByteString = putStrLn
|
||||||
|
{-# SPECIALIZE putByteString :: BS.ByteString -> Base.IO () #-}
|
||||||
|
|
||||||
|
putLByteString :: MonadIO m => BL.ByteString -> m ()
|
||||||
|
putLByteString = putStrLn
|
||||||
|
{-# SPECIALIZE putLByteString :: BL.ByteString -> Base.IO () #-}
|
||||||
|
|
||||||
|
putErrText :: MonadIO m => T.Text -> m ()
|
||||||
|
putErrText = putErrLn
|
||||||
|
{-# SPECIALIZE putErrText :: T.Text -> Base.IO () #-}
|
||||||
@@ -0,0 +1,75 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE Unsafe #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Protolude.Unsafe (
|
||||||
|
unsafeHead,
|
||||||
|
unsafeTail,
|
||||||
|
unsafeInit,
|
||||||
|
unsafeLast,
|
||||||
|
unsafeFromJust,
|
||||||
|
unsafeIndex,
|
||||||
|
unsafeThrow,
|
||||||
|
unsafeRead,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Protolude.Base (Int)
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||||
|
import Protolude.Base (HasCallStack)
|
||||||
|
#endif
|
||||||
|
import Data.Char (Char)
|
||||||
|
import Text.Read (Read, read)
|
||||||
|
import qualified Data.List as List
|
||||||
|
import qualified Data.Maybe as Maybe
|
||||||
|
import qualified Control.Exception as Exc
|
||||||
|
|
||||||
|
unsafeThrow :: Exc.Exception e => e -> a
|
||||||
|
unsafeThrow = Exc.throw
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||||
|
unsafeHead :: HasCallStack => [a] -> a
|
||||||
|
unsafeHead = List.head
|
||||||
|
|
||||||
|
unsafeTail :: HasCallStack => [a] -> [a]
|
||||||
|
unsafeTail = List.tail
|
||||||
|
|
||||||
|
unsafeInit :: HasCallStack => [a] -> [a]
|
||||||
|
unsafeInit = List.init
|
||||||
|
|
||||||
|
unsafeLast :: HasCallStack => [a] -> a
|
||||||
|
unsafeLast = List.last
|
||||||
|
|
||||||
|
unsafeFromJust :: HasCallStack => Maybe.Maybe a -> a
|
||||||
|
unsafeFromJust = Maybe.fromJust
|
||||||
|
|
||||||
|
unsafeIndex :: HasCallStack => [a] -> Int -> a
|
||||||
|
unsafeIndex = (List.!!)
|
||||||
|
|
||||||
|
unsafeRead :: (HasCallStack, Read a) => [Char] -> a
|
||||||
|
unsafeRead = Text.Read.read
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
|
#if ( __GLASGOW_HASKELL__ < 800 )
|
||||||
|
unsafeHead :: [a] -> a
|
||||||
|
unsafeHead = List.head
|
||||||
|
|
||||||
|
unsafeTail :: [a] -> [a]
|
||||||
|
unsafeTail = List.tail
|
||||||
|
|
||||||
|
unsafeInit :: [a] -> [a]
|
||||||
|
unsafeInit = List.init
|
||||||
|
|
||||||
|
unsafeLast :: [a] -> a
|
||||||
|
unsafeLast = List.last
|
||||||
|
|
||||||
|
unsafeFromJust :: Maybe.Maybe a -> a
|
||||||
|
unsafeFromJust = Maybe.fromJust
|
||||||
|
|
||||||
|
unsafeIndex :: [a] -> Int -> a
|
||||||
|
unsafeIndex = (List.!!)
|
||||||
|
|
||||||
|
unsafeRead :: Read a => [Char] -> a
|
||||||
|
unsafeRead = Text.Read.read
|
||||||
|
#endif
|
||||||
Reference in New Issue
Block a user