haskell-effectful/effectful-contrib
1
1
Fork 0
mirror of https://github.com/haskell-effectful/effectful-contrib.git synced 2024-11-22 23:46:28 +03:00
Code Issues Projects Releases Wiki Activity

Move bindings to their own repositories

Browse Source
This commit is contained in:
Hécate Moonlight 2022-02-23 00:02:53 +01:00
parent a68a03ec0e
commit b013ed8c89
59 changed files with 9 additions and 3106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
.editorconfig
View File

@ -1,17 +0,0 @@
# http://editorconfig.org
root = true
[*.hs]
indent_style = space
indent_size = 2
trim_trailing_whitespace = true
insert_final_newline = true
charset = utf-8
end_of_line = lf
[LICENSE]
insert_final_newline = false
[Makefile]
indent_style = tab

75
.github/workflows/ci.yml vendored
View File

@ -1,75 +0,0 @@
name: CI
# Trigger the workflow on push or pull request, but only for the main branch
on:
pull_request:
push:
branches: ["main"]
jobs:
cabal:
name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ubuntu-latest]
cabal: ["3.4.0.0"]
ghc: ["8.8.4", "8.10.7"]
steps:
- uses: actions/checkout@v2
if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/main'
- name: Configure environment
run: |
git config --global http.sslVerify false
echo "/nix/var/nix/profiles/per-user/$USER/profile/bin" >> "$GITHUB_PATH"
echo "/nix/var/nix/profiles/default/bin" >> "$GITHUB_PATH"
echo "NIX_SSL_CERT_FILE=$cert_file" >> "$GITHUB_ENV"
cert_file=/nix/var/nix/profiles/default/etc/ssl/certs/ca-bundle.crt
env
- name: Configure Darwin Nixpkgs
if: matrix.os == 'macos-latest'
run: |
echo 'NIX_PATH="nixpkgs=channel:nixpkgs-21.11-darwin"' >> "$GITHUB_ENV"
- name: Configure Linux Nixpkgs
if: matrix.os == 'ubuntu-latest'
run: |
echo 'NIX_PATH="nixpkgs=channel:nixos-21.11"' >> "$GITHUB_ENV"
- name: Set GHC version for Nix
run: |
if [[ ${{matrix.ghc}} == '8.8.4' ]]
then echo "GHC='884'" >> "$GITHUB_ENV"
elif [[ ${{matrix.ghc}} == '8.10.7' ]]
then echo "GHC='8107'" >> "$GITHUB_ENV"
fi
- name: Install Nix
run: ./.github/workflows/install-nix.sh
- name: Configure
run: nix-shell --pure -I ${{ env.NIX_PATH }} --argstr ghcVersion ${{env.GHC}} --run 'cabal update && cabal configure --enable-tests --disable-benchmarks --test-show-details=direct --disable-optimization --with-compiler="ghc-${{ matrix.ghc }}"' .github/workflows/shell.nix
- name: Freeze
run: nix-shell --pure -I ${{ env.NIX_PATH }} --argstr ghcVersion ${{env.GHC}} --run 'cabal freeze' .github/workflows/shell.nix
- uses: actions/cache@v2
name: Cache ~/.cabal/store
with:
path: ~/.cabal/store
key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
- name: Installing dependencies
run: nix-shell --pure -I ${{ env.NIX_PATH }} --argstr ghcVersion ${{env.GHC}} --run 'make deps' .github/workflows/shell.nix
- name: Running hlint
run: nix-shell --pure -I ${{ env.NIX_PATH }} --argstr ghcVersion ${{env.GHC}} --run './.github/workflows/hlint-runner.sh' .github/workflows/shell.nix
- name: Build
run: nix-shell --pure -I ${{ env.NIX_PATH }} --argstr ghcVersion ${{env.GHC}} --run 'make build' .github/workflows/shell.nix
- name: Test
run: nix-shell --pure -I ${{ env.NIX_PATH }} --argstr ghcVersion ${{env.GHC}} --run 'make test' .github/workflows/shell.nix

12
.github/workflows/cpus.sh vendored
View File

@ -1,12 +0,0 @@
#!/bin/sh
# Originally from:
# https://github.com/blankpage/e5UNIXBuilder/blob/master/build-akili.sh
if [[ "$OSTYPE" =~ "linux-gnu" ]]
then CPUS=$(nproc)
elif [[ "$OSTYPE" =~ "darwin" ]]
then CPUS=2
else CPUS=$(sysctl -n hw.ncpu)
fi
export CPUS

22
.github/workflows/hlint-runner.sh vendored
View File

@ -1,22 +0,0 @@
#!/usr/bin/env bash
set -eux
source .github/workflows/cpus.sh
git add .
find src test -name "*.hs" | parallel -j "$CPUS" -- hlint --refactor-options="-i" --refactor {}
git status
set +e
git diff --exit-code
diff_code=$?
if [ $diff_code -ne 0 ]
then
echo "Test Hlint failed"
exit 1
fi

48
.github/workflows/install-nix.sh vendored
View File

@ -1,48 +0,0 @@
#!/usr/bin/env bash
set -euo pipefail
if type -p nix &>/dev/null ; then
echo "Aborting: Nix is already installed at $(type -p nix)"
exit
fi
# Configure Nix
add_config() {
echo "$1" | sudo tee -a /tmp/nix.conf >/dev/null
}
# Set jobs to number of cores
add_config "max-jobs = auto"
# Allow binary caches for user
add_config "trusted-users = root $USER"
# Nix installer flags
installer_options=(
--daemon
--daemon-user-count 4
--no-channel-add
--darwin-use-unencrypted-nix-store-volume
--nix-extra-conf-file /tmp/nix.conf
)
echo "installer options: ${installer_options[@]}"
# On self-hosted runners we don't need to install more than once
if [[ ! -d /nix/store ]]
then
sh <(curl --retry 5 --retry-connrefused -L "https://nixos.org/nix/install") "${installer_options[@]}"
fi
if [[ $OSTYPE =~ darwin ]]; then
# Disable spotlight indexing of /nix to speed up performance
sudo mdutil -i off /nix
# macOS needs certificates hints
cert_file=/nix/var/nix/profiles/default/etc/ssl/certs/ca-bundle.crt
export NIX_SSL_CERT_FILE=$cert_file
sudo launchctl setenv NIX_SSL_CERT_FILE "$cert_file"
fi
# Set paths
# if [[ $INPUT_NIX_PATH != "" ]]; then
# echo "NIX_PATH=${INPUT_NIX_PATH}" >> "$GITHUB_ENV"
# fi

29
.github/workflows/shell.nix vendored
View File

@ -1,29 +0,0 @@
{ ghcVersion }:
let pkgs = import <nixpkgs> {};
in with pkgs;
mkShell {
buildInputs = [
# Haskell Deps
haskell.compiler."ghc${ghcVersion}"
cabal-install
hlint
haskellPackages.apply-refact
stylish-haskell
# DB Deps
postgresql_13
gmp
zlib
glibcLocales
# Extra
parallel
git
# mkdocs
gnumake
];
shellHook = ''
export LOCALE_ARCHIVE="/nix/store/m53mq2077pfxhqf37gdbj7fkkdc1c8hc-glibc-locales-2.27/lib/locale/locale-archive"
export LC_ALL=C.UTF-8
'';
}

7
.gitignore vendored
View File

@ -1,7 +0,0 @@
dist-newstyle
.hie
cabal.project.local
Session.vim
.hspec-failures
tags
tags.mtime

29
.hlint.yaml
View File

@ -1,29 +0,0 @@
- arguments:
- "-XConstraintKinds"
- "-XDeriveGeneric"
- "-XGeneralizedNewtypeDeriving"
- "-XLambdaCase"
- "-XOverloadedStrings"
- "-XRecordWildCards"
- "-XScopedTypeVariables"
- "-XStandaloneDeriving"
- "-XTupleSections"
- "-XTypeApplications"
- "-XViewPatterns"
- ignore:
name: Avoid lambda
- ignore:
name: Use uncurry
- ignore:
name: Use newtype instead of data
- ignore:
name: Use head
- ignore:
name: Use Foldable.forM_
- ignore:
name: "Eta reduce"
- ignore:
name: "Avoid lambda"
lhs: "return ()"
note: "Use 'pure ()'"
rhs: pass

364
.stylish-haskell.yaml
View File

@ -1,364 +0,0 @@
# stylish-haskell configuration file
# ==================================
# The stylish-haskell tool is mainly configured by specifying steps. These steps
# are a list, so they have an order, and one specific step may appear more than
# once (if needed). Each file is processed by these steps in the given order.
steps:
# Convert some ASCII sequences to their Unicode equivalents. This is disabled
# by default.
# - unicode_syntax:
# # In order to make this work, we also need to insert the UnicodeSyntax
# # language pragma. If this flag is set to true, we insert it when it's
# # not already present. You may want to disable it if you configure
# # language extensions using some other method than pragmas. Default:
# # true.
# add_language_pragma: true
# Format module header
#
# Currently, this option is not configurable and will format all exports and
# module declarations to minimize diffs
#
# - module_header:
# # How many spaces use for indentation in the module header.
# indent: 4
#
# # Should export lists be sorted? Sorting is only performed within the
# # export section, as delineated by Haddock comments.
# sort: true
#
# # See `separate_lists` for the `imports` step.
# separate_lists: true
# Format record definitions. This is disabled by default.
#
# You can control the layout of record fields. The only rules that can't be configured
# are these:
#
# - "|" is always aligned with "="
# - "," in fields is always aligned with "{"
# - "}" is likewise always aligned with "{"
#
- records:
# How to format equals sign between type constructor and data constructor.
# Possible values:
# - "same_line" -- leave "=" AND data constructor on the same line as the type constructor.
# - "indent N" -- insert a new line and N spaces from the beginning of the next line.
equals: "indent 2"
# How to format first field of each record constructor.
# Possible values:
# - "same_line" -- "{" and first field goes on the same line as the data constructor.
# - "indent N" -- insert a new line and N spaces from the beginning of the data constructor
first_field: "same_line"
# How many spaces to insert between the column with "," and the beginning of the comment in the next line.
field_comment: 2
# How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines.
deriving: 2
# How many spaces to insert before "via" clause counted from indentation of deriving clause
# Possible values:
# - "same_line" -- "via" part goes on the same line as "deriving" keyword.
# - "indent N" -- insert a new line and N spaces from the beginning of "deriving" keyword.
via: indent 2
# Sort typeclass names in the "deriving" list alphabetically.
sort_deriving: true
# Wheter or not to break enums onto several lines
#
# Default: false
break_enums: false
# Whether or not to break single constructor data types before `=` sign
#
# Default: true
break_single_constructors: true
# Whether or not to curry constraints on function.
#
# E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@
#
# Instead of @allValues :: (Enum a, Bounded a) => Proxy a -> [a]@
#
# Default: false
curried_context: false
# Align the right hand side of some elements. This is quite conservative
# and only applies to statements where each element occupies a single
# line. All default to true.
# Possible values:
# - always - Always align statements.
# - adjacent - Align statements that are on adjacent lines in groups.
# - never - Never align statements.
# All default to always.
- simple_align:
cases: always
top_level_patterns: always
records: always
multi_way_if: always
# Import cleanup
- imports:
# There are different ways we can align names and lists.
#
# - global: Align the import names and import list throughout the entire
# file.
#
# - file: Like global, but don't add padding when there are no qualified
# imports in the file.
#
# - group: Only align the imports per group (a group is formed by adjacent
# import lines).
#
# - none: Do not perform any alignment.
#
# Default: global.
align: none
# The following options affect only import list alignment.
#
# List align has following options:
#
# - after_alias: Import list is aligned with end of import including
# 'as' and 'hiding' keywords.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - with_alias: Import list is aligned with start of alias or hiding.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - with_module_name: Import list is aligned `list_padding` spaces after
# the module name.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# init, last, length)
#
# This is mainly intended for use with `pad_module_names: false`.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# init, last, length, scanl, scanr, take, drop,
# sort, nub)
#
# - new_line: Import list starts always on new line.
#
# > import qualified Data.List as List
# > (concat, foldl, foldr, head, init, last, length)
#
# - repeat: Repeat the module name to align the import list.
#
# > import qualified Data.List as List (concat, foldl, foldr, head)
# > import qualified Data.List as List (init, last, length)
#
# Default: after_alias
list_align: after_alias
# Right-pad the module names to align imports in a group:
#
# - true: a little more readable
#
# > import qualified Data.List as List (concat, foldl, foldr,
# > init, last, length)
# > import qualified Data.List.Extra as List (concat, foldl, foldr,
# > init, last, length)
#
# - false: diff-safe
#
# > import qualified Data.List as List (concat, foldl, foldr, init,
# > last, length)
# > import qualified Data.List.Extra as List (concat, foldl, foldr,
# > init, last, length)
#
# Default: true
pad_module_names: false
# Long list align style takes effect when import is too long. This is
# determined by 'columns' setting.
#
# - inline: This option will put as much specs on same line as possible.
#
# - new_line: Import list will start on new line.
#
# - new_line_multiline: Import list will start on new line when it's
# short enough to fit to single line. Otherwise it'll be multiline.
#
# - multiline: One line per import list entry.
# Type with constructor list acts like single import.
#
# > import qualified Data.Map as M
# > ( empty
# > , singleton
# > , ...
# > , delete
# > )
#
# Default: inline
long_list_align: inline
# Align empty list (importing instances)
#
# Empty list align has following options
#
# - inherit: inherit list_align setting
#
# - right_after: () is right after the module name:
#
# > import Vector.Instances ()
#
# Default: inherit
empty_list_align: inherit
# List padding determines indentation of import list on lines after import.
# This option affects 'long_list_align'.
#
# - <integer>: constant value
#
# - module_name: align under start of module name.
# Useful for 'file' and 'group' align settings.
#
# Default: 4
list_padding: 4
# Separate lists option affects formatting of import list for type
# or class. The only difference is single space between type and list
# of constructors, selectors and class functions.
#
# - true: There is single space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable (fold, foldl, foldMap))
#
# - false: There is no space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable(fold, foldl, foldMap))
#
# Default: true
separate_lists: true
# Space surround option affects formatting of import lists on a single
# line. The only difference is single space after the initial
# parenthesis and a single space before the terminal parenthesis.
#
# - true: There is single space associated with the enclosing
# parenthesis.
#
# > import Data.Foo ( foo )
#
# - false: There is no space associated with the enclosing parenthesis
#
# > import Data.Foo (foo)
#
# Default: false
space_surround: false
# Enabling this argument will use the new GHC lib parse to format imports.
#
# This currently assumes a few things, it will assume that you want post
# qualified imports. It is also not as feature complete as the old
# imports formatting.
#
# It does not remove redundant lines or merge lines. As such, the full
# feature scope is still pending.
#
# It _is_ however, a fine alternative if you are using features that are
# not parseable by haskell src extensions and you're comfortable with the
# presets.
#
# Default: false
ghc_lib_parser: false
# Language pragmas
- language_pragmas:
# We can generate different styles of language pragma lists.
#
# - vertical: Vertical-spaced language pragmas, one per line.
#
# - compact: A more compact style.
#
# - compact_line: Similar to compact, but wrap each line with
# `{-#LANGUAGE #-}'.
#
# Default: vertical.
style: vertical
# Align affects alignment of closing pragma brackets.
#
# - true: Brackets are aligned in same column.
#
# - false: Brackets are not aligned together. There is only one space
# between actual import and closing bracket.
#
# Default: true
align: false
# stylish-haskell can detect redundancy of some language pragmas. If this
# is set to true, it will remove those redundant pragmas. Default: true.
remove_redundant: false
# Language prefix to be used for pragma declaration, this allows you to
# use other options non case-sensitive like "language" or "Language".
# If a non correct String is provided, it will default to: LANGUAGE.
language_prefix: LANGUAGE
# Replace tabs by spaces. This is disabled by default.
# - tabs:
# # Number of spaces to use for each tab. Default: 8, as specified by the
# # Haskell report.
# spaces: 8
# Remove trailing whitespace
- trailing_whitespace: {}
# Squash multiple spaces between the left and right hand sides of some
# elements into single spaces. Basically, this undoes the effect of
# simple_align but is a bit less conservative.
# - squash: {}
# A common setting is the number of columns (parts of) code will be wrapped
# to. Different steps take this into account.
#
# Set this to null to disable all line wrapping.
#
# Default: 80.
columns: 120
# By default, line endings are converted according to the OS. You can override
# preferred format here.
#
# - native: Native newline format. CRLF on Windows, LF on other OSes.
#
# - lf: Convert to LF ("\n").
#
# - crlf: Convert to CRLF ("\r\n").
#
# Default: native.
newline: native
# Sometimes, language extensions are specified in a cabal file or from the
# command line instead of using language pragmas in the file. stylish-haskell
# needs to be aware of these, so it can parse the file correctly.
#
# No language extensions are enabled by default.
language_extensions:
- ConstraintKinds
- DataKinds
- FlexibleContexts
- FlexibleInstances
- GADTs
- KindSignatures
- ScopedTypeVariables
- TypeApplications
- TypeOperators
# Attempt to find the cabal file in ancestors of the current directory, and
# parse options (currently only language extensions) from that.
#
# Default: true
cabal: true

20
LICENSE.md
View File

@ -1,20 +0,0 @@
Copyright (c) 2021 Hécate Moonlight
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.

23
Makefile
View File

@ -1,23 +0,0 @@
deps: ## Install the dependencies
@cabal build all --only-dependencies
build: ## Build the project in fast mode
@cabal build all -O0
clean: ## Remove compilation artifacts
@cabal clean all
test: ## Run the test suite
@cabal test all
lint: ## Run the code linter (HLint)
@find effectful-* -name "*.hs" | parallel -j $(PROCS) -- hlint --refactor-options="-i" --refactor {}
help:
@grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | awk 'BEGIN {FS = ":.* ?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}'
PROCS := $(shell nproc)
.PHONY: all $(MAKECMDGOALS)
.DEFAULT_GOAL := help

32
README.md
View File

@ -1,34 +1,20 @@
# effectful-contrib [![CI-badge][CI-badge]][CI-url]
# effectful-contrib
This repository hosts bindings for the [`effectful`][effectful] library by
Andrzej Rybczak.
This repository used to host bindings for the [`effectful`][effectful] library by Andrzej Rybczak.
They have now moved to their own repositories:
* [effectful-cache](./effectful-cache): A `Cache` effect to use the
* [effectful-cache](https://github.com/haskell-effectful/effectful-cache): A `Cache` effect to use the
[cache library][cache].
* [effectful-log-base](./effectful-log-base): A `Logging` effect based on the
* [effectful-log-base](https://github.com/haskell-effectful/effectful-log-base): A `Logging` effect based on the
[log-base library][log-base].
* [effectful-log-elasticsearch](./effectful-log-elasticsearch): An ElasticSearch
backend for [effectful-log-base](./effectful-log-base) based on the
* [effectful-log-elasticsearch](https://github.com/haskell-effectful/effectful-log-elasticsearch): An ElasticSearch
backend for [effectful-log-base](https://github.com/haskell-effectful/effectful-log-base) based on the
[log-elasticsearch library][log-elasticsearch].
* [effectful-time](./effectful-time): A `Time` effect to use the
* [effectful-time](https://github.com/haskell-effectful/effectful-time): A `Time` effect to use the
[time library][time].
* [effectful-typed-process](./effectful-typed-process): A `Process` effect based
* [effectful-typed-process](https://github.com/haskell-effectful/effectful-typed-process): A `Process` effect based
on the [typed-process library][typed-process].
## Building and Testing
To build the libraries:
```
$ cabal build all
```
To run all the tests:
```
$ cabal test all
```
[effectful]: https://github.com/arybczak/effectful
[CI-badge]: https://img.shields.io/github/workflow/status/Kleidukos/effectful-contrib/CI?style=flat-square
[CI-url]: https://github.com/Kleidukos/effectful-contrib/actions

14
cabal.project
View File

@ -1,14 +0,0 @@
packages: ./effectful-cache
./effectful-log-base
./effectful-log-elasticsearch
./effectful-time
./effectful-typed-process
./effectful-crypto-rng
with-compiler: ghc-8.10
source-repository-package
type: git
location: https://github.com/arybczak/effectful.git
tag: 109d44165630321f65ef63ad499690768ab2a19b
subdir: effectful effectful-core

3
effectful-cache/.gitignore vendored
View File

@ -1,3 +0,0 @@
dist-newstyle
.hie
.hspec-failures

4
effectful-cache/CHANGELOG.md
View File

@ -1,4 +0,0 @@
# CHANGELOG
## v0.0.1.0 –
* Release

40
effectful-cache/README.md
View File

@ -1,40 +0,0 @@
# Effectful-cache
## Description
A `Cache` effect for the [`effectful`][effectful] ecosystem.
## How to use
This library exposes the following elements:
* `Cache` — The type-level effect that you can declare in your type signatures.
```
populateIntCache :: (Cache Int Int :> es) => Eff es ()
```
* `insert`, `lookup`, `keys`, `delete`, `filterWithKey` – Operations on `Cache`. They should always be used with Type Applications when using literals:
```Haskell
insertAndLookup :: (Cache Int Int :> es) => Eff es (Maybe Int)
insertAndLookup = do
insert @Int @Int 3 12
lookup @Int 3
listKeys :: (Cache Int Int :> es) => Eff es [Int]
listKeys = do
populateIntCache
keys @Int @Int
```
* An IO Runner
```
runCacheIO (cache :: Data.Cache Int Int)
```
See the [tests][tests] to see an example use.
[effectful]: https://github.com/arybczak/effectful
[tests]: https://github.com/Kleidukos/effectful-contrib/blob/main/effectful-cache/test/Main.hs

82
effectful-cache/effectful-cache.cabal
View File

@ -1,82 +0,0 @@
cabal-version: 3.0
name: effectful-cache
version: 0.0.1.0
homepage: https://github.com/Kleidukos/effectful-contrib/tree/main/effectful-cache#readme
bug-reports: https://github.com/Kleidukos/effectful-contrib/issues
author: Hécate Moonlight
maintainer: Hécate Moonlight
license: MIT
build-type: Simple
extra-source-files:
CHANGELOG.md
LICENSE.md
README.md
source-repository head
type: git
location: https://github.com/Kleidukos/effectful-contrib
common common-extensions
default-extensions: ConstraintKinds
DataKinds
FlexibleContexts
FlexibleInstances
GADTs
KindSignatures
ScopedTypeVariables
TypeApplications
TypeFamilies
TypeOperators
default-language: Haskell2010
common common-ghc-options
ghc-options: -Wall
-Wcompat
-Werror
-Widentities
-Wincomplete-record-updates
-Wincomplete-uni-patterns
-Wpartial-fields
-Wredundant-constraints
-fhide-source-paths
-Wno-unused-do-bind
-fwrite-ide-info
-hiedir=.hie
-haddock
-j
common common-rts-options
ghc-options: -rtsopts
-threaded
-with-rtsopts=-N
library
import: common-extensions
import: common-ghc-options
hs-source-dirs:
src
exposed-modules:
Effectful.Cache
build-depends:
base <= 4.17,
cache,
hashable,
effectful-core
test-suite effectful-cache-test
import: common-extensions
import: common-ghc-options
import: common-rts-options
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules:
Utils
hs-source-dirs:
test
build-depends:
, base
, effectful-cache
, effectful-core
, cache
, hashable
, hspec

127
effectful-cache/src/Effectful/Cache.hs
View File

@ -1,127 +0,0 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Strict #-}
{-|
Module : Effectful.Cache
Copyright : © Hécate Moonlight, 2021
License : MIT
Maintainer : hecate@glitchbra.in
Stability : stable
An effect wrapper around Data.Cache for the Effectful ecosystem
-}
module Effectful.Cache
( -- * The /Cache/ effect
Cache(..)
-- * Handlers
, runCacheIO
-- * Cache operations
, insert
, lookup
, keys
, delete
, filterWithKey
) where
import Control.Monad.IO.Class
import Data.Hashable
import Data.Kind
import Effectful.Dispatch.Dynamic
import Effectful.Monad
import Prelude hiding (lookup)
import qualified Data.Cache as C
-- | Operations on a cache
-- Since it is an effect with type variables, you will have the duty of making unambiguous calls to the provided
-- functions. This means that with numerical literals ('3', '4', etc), visible type applications will be necessary.
-- See each function's documentation for examples.
data Cache k v :: Effect where
Insert :: (Eq k, Hashable k) => k -> v -> Cache k v m ()
Lookup :: (Eq k, Hashable k) => k -> Cache k v m (Maybe v)
Keys :: Cache k v m [k]
Delete :: (Eq k, Hashable k) => k -> Cache k v m ()
FilterWithKey :: (Eq k, Hashable k) => (k -> v -> Bool) -> Cache k v m ()
type instance DispatchOf (Cache k v) = 'Dynamic
-- | The default IO handler
runCacheIO :: forall (k :: Type) (v :: Type) (es :: [Effect]) (a :: Type)
. (Eq k, Hashable k, IOE :> es)
=> C.Cache k v
-> Eff (Cache k v : es) a
-> Eff es a
runCacheIO cache = interpret $ \_ -> \case
Insert key value -> liftIO $ C.insert cache key value
Lookup key -> liftIO $ C.lookup cache key
Keys -> liftIO $ C.keys cache
Delete key -> liftIO $ C.delete cache key
FilterWithKey fun -> liftIO $ C.filterWithKey fun cache
-- | Insert an item in the cache, using the default expiration value of the cache.
insert :: forall (k :: Type) (v :: Type) (es :: [Effect])
. (Eq k, Hashable k, Cache k v :> es)
=> k -> v -> Eff es ()
insert key value = send $ Insert key value
-- | Lookup an item with the given key, and delete it if it is expired.
--
-- The function will only return a value if it is present in the cache and if the item is not expired.
-- The function will eagerly delete the item from the cache if it is expired.
lookup :: forall (k :: Type) (v :: Type) (es :: [Effect])
. (Eq k, Hashable k, Cache k v :> es)
=> k -> Eff es (Maybe v)
lookup key = send $ Lookup key
-- | List all the keys of the cache.
--
-- Since 'Cache' has type variables, you will need to use visible type applications or explicitly typed
-- arguments for the key *and* value parameters to distinguish this 'Cache' from potentially other ones.
--
-- === __Example__
--
-- > listKeys :: (Cache Int Int :> es) => Eff es [Int]
-- > listKeys = do
-- > mapM_ (\(k,v) -> insert @Int @Int k v) [(2,4),(3,6),(4,8),(5,10)]
-- > keys @Int @Int -- [2,3,4,5]
keys :: forall (k :: Type) (v :: Type) (es :: [Effect])
. (Cache k v :> es) => Eff es [k]
keys = send @(Cache k v) Keys
-- | Delete the provided key from the cache it is present.
--
-- Since 'Cache' has type variables, you will need to use visible type applications or explicitly typed
-- arguments for the key *and* value parameters to distinguish this 'Cache' from potentially other ones.
--
-- === __Example__
--
-- > deleteKeys :: (Cache Int Int :> es) => Eff es [Int]
-- > deleteKeys = do
-- > mapM_ (\(k,v) -> insert @Int @Int k v) [(2,4),(3,6),(4,8),(5,10)]
-- > delete @Int @Int 3
-- > delete @Int @Int 5
-- > keys @Int @Int -- [2,4]
delete :: forall (k :: Type) (v :: Type) (es :: [Effect])
. (Eq k, Hashable k, Cache k v :> es)
=> k -> Eff es ()
delete key = send @(Cache k v) $ Delete key
-- | Keeps elements that satisfy the predicate (used for cache invalidation).
--
-- Note that the predicate might be called for expired items.
--
-- Since 'Cache' has type variables, you will need to use visible type applications or explicitly typed
-- arguments for the key *and* value parameters to distinguish this 'Cache' from potentially other ones.
--
-- === __Example__
--
-- > filterKeys :: (Cache Int Int :> es) => Eff es [Int]
-- > filterKeys = do
-- > mapM_ (\(k,v) -> insert @Int @Int k v) [(2,4),(3,6),(4,8),(5,10)]
-- > filterWithKey @Int @Int (\k _ -> k /= 3)
-- > keys @Int @Int -- [2,4,5]
filterWithKey :: forall (k :: Type) (v :: Type) (es :: [Effect])
. (Eq k, Hashable k, Cache k v :> es)
=> (k -> v -> Bool) -> Eff es ()
filterWithKey fun = send $ FilterWithKey fun

76
effectful-cache/test/Main.hs
View File

@ -1,76 +0,0 @@
{-# LANGUAGE NoOverloadedStrings #-}
module Main where
import qualified Data.Cache as C
import Effectful.Monad
import Prelude hiding (lookup)
import Test.Hspec as H
import qualified Utils as U
import Effectful.Cache
main :: IO ()
main = hspec spec
initStringCache :: IO (C.Cache String String)
initStringCache = C.newCache Nothing
initIntCache :: IO (C.Cache Int Int)
initIntCache = C.newCache Nothing
populateIntCache :: (Cache Int Int :> es) => Eff es ()
populateIntCache =
mapM_ (\(k,v) -> insert @Int @Int k v) [(2,4),(3,6),(4,8),(5,10)]
spec :: Spec
spec = do
describe "Testing Cache" $ do
it "Insert & Lookup" $ testInsertAndLookup =<< initIntCache
it "Listing keys" $ testListKeys =<< initIntCache
it "Deleting keys" $ testDeleteKeys =<< initIntCache
it "Filter with key" $ testFilterWithKey =<< initIntCache
---
testInsertAndLookup :: C.Cache Int Int -> Expectation
testInsertAndLookup cache = runEff $ do
result <- runCacheIO cache insertAndLookup
result `U.shouldBe` Just 12
insertAndLookup :: (Cache Int Int :> es) => Eff es (Maybe Int)
insertAndLookup = do
insert @Int @Int 3 12
lookup @Int 3
testListKeys :: C.Cache Int Int -> Expectation
testListKeys cache = runEff $ do
result <- runCacheIO cache listKeys
result `U.shouldBe` [2,3,4,5]
listKeys :: (Cache Int Int :> es) => Eff es [Int]
listKeys = do
populateIntCache
keys @Int @Int
testDeleteKeys :: C.Cache Int Int -> Expectation
testDeleteKeys cache = runEff $ do
result <- runCacheIO cache deleteKeys
result `U.shouldBe` [2,4]
deleteKeys :: (Cache Int Int :> es) => Eff es [Int]
deleteKeys = do
populateIntCache
delete @Int @Int 3
delete @Int @Int 5
keys @Int @Int
testFilterWithKey :: C.Cache Int Int -> Expectation
testFilterWithKey cache = runEff $ do
result <- runCacheIO cache filterKeys
result `U.shouldBe` [2,4,5]
filterKeys :: (Cache Int Int :> es) => Eff es [Int]
filterKeys = do
populateIntCache
filterWithKey @Int @Int (\k _ -> k /= 3)
keys @Int @Int -- [2,4,5]

11
effectful-cache/test/Utils.hs
View File

@ -1,11 +0,0 @@
module Utils where
import Control.Monad.IO.Class
import Effectful.Monad
import GHC.Stack
import qualified Test.Hspec as H
shouldBe :: (HasCallStack, Eq a, Show a, IOE :> es)
=> a -> a -> Eff es ()
shouldBe expected given = liftIO $ expected `H.shouldBe` given

3
effectful-crypto-rng/.gitignore vendored
View File

@ -1,3 +0,0 @@
dist-newstyle
.hie
.hspec-failures

4
effectful-crypto-rng/CHANGELOG.md
View File

@ -1,4 +0,0 @@
# CHANGELOG
## v0.0.1.0 –
* Release

50
effectful-crypto-rng/README.md
View File

@ -1,50 +0,0 @@
# effectful-crypto-rng
## Description
A `CryptoRNG` effect for the [`effectful`][effectful] ecosystem.
## How to use
This library exposes the following elements:
* `CryptoRNG` — The type-level effect that you can declare in your type signatures.
example:
```haskell
generateUID :: (CryptoRNG :> es) => Eff es UID
```
* `randomR`, `randomBytes`, `randomString`
Functions to get random data from the system's PRNG.
```haskell
newtype UID = UID ByteString
deriving newtype (Show, Eq, Ord)
import Effectful.Crypto.RNG
generateUID :: (CryptoRNG :> es ) => Eff es UID
generateUID = do
bytes <- randomBytes 8
pure $ UID bytes
```
* Runner:
```Haskell
main :: IO ()
main = runEff $ do
rng <- newCryptoRNGState
result <- runCryptoRNG rng
$ generateUID
liftIO $ print result
```
See the [tests][tests] to see an example use.
[effectful]: https://github.com/arybczak/effectful
[tests]: https://github.com/Kleidukos/effectful-contrib/blob/main/effectful-crypto-rng/test/Main.hs

101
effectful-crypto-rng/effectful-crypto-rng.cabal
View File

@ -1,101 +0,0 @@
cabal-version: 3.0
name: effectful-crypto-rng
version: 0.0.1.0
homepage: https://github.com/Kleidukos/effectful-contrib/tree/main/effectful-crypto-rng#readme
bug-reports: https://github.com/Kleidukos/effectful-contrib/issues
author: Hécate Moonlight
maintainer: Hécate Moonlight
license: MIT
build-type: Simple
extra-source-files:
CHANGELOG.md
LICENSE.md
README.md
source-repository head
type: git
location: https://github.com/Kleidukos/effectful-contrib
common common-extensions
default-extensions: ConstraintKinds
DataKinds
DeriveAnyClass
DeriveGeneric
DerivingStrategies
DerivingVia
DuplicateRecordFields
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
NamedFieldPuns
OverloadedStrings
RankNTypes
RecordWildCards
ScopedTypeVariables
StandaloneDeriving
Strict
TypeApplications
TypeFamilies
TypeOperators
default-language: Haskell2010
common common-ghc-options
ghc-options: -Wall
-Wcompat
-Werror
-Widentities
-Wincomplete-record-updates
-Wincomplete-uni-patterns
-Wpartial-fields
-Wredundant-constraints
-fhide-source-paths
-Wno-unused-do-bind
-fwrite-ide-info
-hiedir=.hie
-haddock
-j
common common-rts-options
ghc-options: -rtsopts
-threaded
-with-rtsopts=-N
library
import: common-extensions
import: common-ghc-options
hs-source-dirs:
src
exposed-modules:
Effectful.Crypto.RNG
Effectful.Crypto.RNG.Dynamic
build-depends:
base <= 4.17,
bytestring,
crypto-rng,
crypto-api,
effectful-core
test-suite effectful-crypto-rng-test
import: common-extensions
import: common-ghc-options
import: common-rts-options
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules:
Dynamic
Static
Utils
hs-source-dirs:
test
build-depends:
, base
, bytestring
, effectful-crypto-rng
, effectful-core
, crypto-rng
, hspec

80
effectful-crypto-rng/src/Effectful/Crypto/RNG.hs
View File

@ -1,80 +0,0 @@
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-|
Module : Effectful.Crypto.RNG
Copyright : © Hécate Moonlight, 2021
Dominik Peteler, 2021
License : MIT
Maintainer : hecate@glitchbra.in
Stability : stable
An effect wrapper around Crypto.RNG for the Effectful ecosystem
-}
module Effectful.Crypto.RNG
( -- * CryptoRNG Effect
CryptoRNG
-- * Runner
, runCryptoRNG
-- * CryptorRNG functions
, CryptoRNGState
, randomString
, randomBytes
, randomR
, newCryptoRNGState
, unsafeCryptoRNGState
-- * Re-exports from Crypto.RNG
, C.mapCryptoRNGT
, C.runCryptoRNGT
, C.withCryptoRNGState
) where
import Crypto.Classes (ByteLength)
import Crypto.RNG (CryptoRNGState)
import Data.ByteString (ByteString)
import Effectful.Dispatch.Static
import Effectful.Monad
import qualified Crypto.RNG as C
import qualified Crypto.RNG.Utils as C
-- | An effect for the cryptographic random generator provided by the DRBG package.
data CryptoRNG :: Effect
type instance DispatchOf CryptoRNG = 'Static
newtype instance StaticRep CryptoRNG = CryptoRNG CryptoRNGState
-- | The default Effect handler
runCryptoRNG
:: IOE :> es
=> CryptoRNGState
-> Eff (CryptoRNG : es) a
-> Eff es a
runCryptoRNG rngState = evalStaticRep (CryptoRNG rngState)
-- | Create a new 'CryptoRNGState', based on system entropy.
newCryptoRNGState :: IOE :> es => Eff es CryptoRNGState
newCryptoRNGState = C.newCryptoRNGState
-- | Create a new 'CryptoRNGState', based on a bytestring seed.
-- Should only be used for testing.
unsafeCryptoRNGState :: IOE :> es => ByteString -> Eff es CryptoRNGState
unsafeCryptoRNGState seed = C.unsafeCryptoRNGState seed
-- | Generate given number of cryptographically secure random bytes.
randomBytes :: CryptoRNG :> es => ByteLength -> Eff es ByteString
randomBytes len = do
CryptoRNG rngState <- getStaticRep
unsafeEff_ $ C.randomBytesIO len rngState
-- | Generate random string of specified length that contains allowed chars.
randomString :: CryptoRNG :> es => Int -> String -> Eff es String
randomString len allowedChars = do
CryptoRNG rngState <- getStaticRep
unsafeEff_ $ C.runCryptoRNGT rngState (C.randomString len allowedChars)
-- | Generate a cryptographically secure random number in given, closed range.
randomR :: (CryptoRNG :> es, Integral a) => (a, a) -> Eff es a
randomR (low, high) = do
CryptoRNG rngState <- getStaticRep
unsafeEff_ $ C.runCryptoRNGT rngState $ C.randomR (low, high)

78
effectful-crypto-rng/src/Effectful/Crypto/RNG/Dynamic.hs
View File

@ -1,78 +0,0 @@
{-|
Module : Effectful.Crypto.RNG.Dynamic
Copyright : © Hécate Moonlight, 2021
License : MIT
Maintainer : hecate@glitchbra.in
Stability : stable
An effect wrapper around Crypto.RNG for the Effectful ecosystem
-}
module Effectful.Crypto.RNG.Dynamic
(
-- * CryptoRNG Effect
CryptoRNG(..)
-- * Runner
, runCryptoRNG
-- * CryptorRNG functions
, CryptoRNGState
, randomString
, randomBytes
, randomR
, newCryptoRNGState
, unsafeCryptoRNGState
-- * Re-exports from Crypto.RNG
, C.mapCryptoRNGT
, C.runCryptoRNGT
, C.withCryptoRNGState
) where
import Control.Monad.IO.Class
import Crypto.Classes (ByteLength)
import Crypto.RNG (CryptoRNGState)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Effectful.Dispatch.Dynamic (interpret, send)
import Effectful.Monad
import qualified Crypto.RNG as C
import qualified Crypto.RNG.Utils as C
-- | An effect for the cryptographic random generator provided by the DRBG package.
data CryptoRNG :: Effect where
RandomBytes :: ByteLength -> CryptoRNG m ByteString
RandomString :: ByteLength -> String -> CryptoRNG m String
RandomR :: (Integral a) => (a, a) -> CryptoRNG m a
type instance DispatchOf CryptoRNG = 'Dynamic
-- | The default Effect handler
runCryptoRNG :: forall (es :: [Effect]) (a :: Type)
. (IOE :> es)
=> CryptoRNGState
-> Eff (CryptoRNG : es) a
-> Eff es a
runCryptoRNG rngState = interpret $ \_ -> \case
RandomBytes n -> liftIO $ C.randomBytesIO n rngState
RandomString len allowedChars -> C.runCryptoRNGT rngState (C.randomString len allowedChars)
RandomR (low, high) -> C.runCryptoRNGT rngState $ C.randomR (low, high)
-- | Create a new 'CryptoRNGState', based on system entropy.
newCryptoRNGState :: IOE :> es => Eff es CryptoRNGState
newCryptoRNGState = C.newCryptoRNGState
-- | Create a new 'CryptoRNGState', based on a bytestring seed.
-- Should only be used for testing.
unsafeCryptoRNGState :: IOE :> es => ByteString -> Eff es CryptoRNGState
unsafeCryptoRNGState seed = C.unsafeCryptoRNGState seed
-- | Generate given number of cryptographically secure random bytes.
randomBytes :: (CryptoRNG :> es) => ByteLength -> Eff es ByteString
randomBytes len = send $ RandomBytes len
-- | Generate random string of specified length that contains allowed chars.
randomString :: (CryptoRNG :> es) => Int -> String -> Eff es String
randomString len allowedChars = send $ RandomString len allowedChars
-- | Generate a cryptographically secure random number in given,
-- closed range.
randomR :: (CryptoRNG :> es, Integral a) => (a, a) -> Eff es a
randomR = send . RandomR

44
effectful-crypto-rng/test/Dynamic.hs
View File

@ -1,44 +0,0 @@
module Dynamic (spec) where
import Control.Monad
import Data.ByteString
import Effectful.Monad
import Effectful.Reader
import Test.Hspec as H
import Effectful.Crypto.RNG.Dynamic
spec :: Spec
spec = do
describe "Dynamic" $ do
it "Genering random bytes wrapped in a newtype" testRandomBytes
it "Generating a random number within a range from Reader" testRandomNumber
---
testRandomNumber :: Expectation
testRandomNumber = runEff $ do
cryptoState <- newCryptoRNGState
void $ runCryptoRNG cryptoState
. runReader ((10, 20) :: (Int, Int))
$ generatingRandomNumber
generatingRandomNumber :: (CryptoRNG :> es, Reader (Int, Int) :> es) => Eff es Int
generatingRandomNumber = do
bounds <- ask
randomR bounds
---
testRandomBytes :: Expectation
testRandomBytes = runEff $ do
cryptoState <- newCryptoRNGState
void $ runCryptoRNG cryptoState generateUID
newtype UID = UID ByteString
deriving newtype (Show, Eq, Ord)
generateUID :: (CryptoRNG :> es ) => Eff es UID
generateUID = do
bytes <- randomBytes 8
pure $ UID bytes

15
effectful-crypto-rng/test/Main.hs
View File

@ -1,15 +0,0 @@
module Main (main) where
import Test.Hspec
import qualified Dynamic
import qualified Static
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "Testing CryptoRNG" $ do
Dynamic.spec
Static.spec

44
effectful-crypto-rng/test/Static.hs
View File

@ -1,44 +0,0 @@
module Static (spec) where
import Control.Monad
import Data.ByteString
import Effectful.Monad
import Effectful.Reader
import Test.Hspec as H
import Effectful.Crypto.RNG
spec :: Spec
spec = do
describe "Static" $ do
it "Genering random bytes wrapped in a newtype" testRandomBytes
it "Generating a random number within a range from Reader" testRandomNumber
---
testRandomNumber :: Expectation
testRandomNumber = runEff $ do
cryptoState <- newCryptoRNGState
void $ runCryptoRNG cryptoState
. runReader ((10, 20) :: (Int, Int))
$ generatingRandomNumber
generatingRandomNumber :: (CryptoRNG :> es, Reader (Int, Int) :> es) => Eff es Int
generatingRandomNumber = do
bounds <- ask
randomR bounds
---
testRandomBytes :: Expectation
testRandomBytes = runEff $ do
cryptoState <- newCryptoRNGState
void $ runCryptoRNG cryptoState generateUID
newtype UID = UID ByteString
deriving newtype (Show, Eq, Ord)
generateUID :: (CryptoRNG :> es ) => Eff es UID
generateUID = do
bytes <- randomBytes 8
pure $ UID bytes

11
effectful-crypto-rng/test/Utils.hs
View File

@ -1,11 +0,0 @@
module Utils where
import Control.Monad.IO.Class
import Effectful.Monad
import GHC.Stack
import qualified Test.Hspec as H
shouldBe :: (HasCallStack, Eq a, Show a, IOE :> es)
=> a -> a -> Eff es ()
shouldBe expected given = liftIO $ expected `H.shouldBe` given

4
effectful-log-base/CHANGELOG.md
View File

@ -1,4 +0,0 @@
# CHANGELOG
## v0.0.1.0 –
* Release

64
effectful-log-base/README.md
View File

@ -1,64 +0,0 @@
# effectful-log-base
## Description
This package provides a `Logging` effect for the [`effectful`][effectful]
ecosystem based on the [`log-base`][log-base] library.
In addition to that it contains an instance of
[`Log.Class.MonadLog`](https://hackage.haskell.org/package/log-base-0.10.0.1/docs/Log-Class.html#t:MonadLog)
for the `Eff` monad.
## How to use
This library provides the following modules:
- `Effectful.Log`
This is module contains the core of `effectful-log-base`. In particular, the
`Logging` effect and the functions associated with it are defined here.
Additionally, this module provides the `MonadLog` instance for the `Eff` monad.
- `Effectful.Log.Backend.*`
The modules in this namespace provide handlers for the `Logging` effect for a
specific backend. They also include lifted versions of the functions found in
the corresponding namespace of the `log-base` package.
- `Effectful.Log.Logger`
This module contains functions which are useful if you want to implement
custom loggers.
To start using `effectful-log-base` package you must obtain a `Logger` which
serves as a sink for the log messages of your application.
To do so, you must choose a logging backend. This backend usually comes with a
function like `withSomeLogger :: (Logger -> Eff es a) -> Eff es a`.
Use this `Logger` along with the other configuration options to handle the
`Logging` effect with `Effectful.Log.runLogging`.
Log messages are written using one of the functions of the `log*` family found
in `Effectful.Log`. Since log messages have a timestamp emitting those will
incure a `Time :> es` constraint as well. Use one of the functions provided by
the [`effectful-time`][effectful-time] package to handle that effect.
Here is a full working example (also found in the `effectful-log-base/examples/`
directory of this repository):
```haskell
{-# LANGUAGE OverloadedStrings #-}
import Data.Text (Text)
import Effectful.Monad
import Effectful.Time (Time, runCurrentTimeIO)
import Log (LogLevel(LogInfo), logInfo)
import Effectful.Log
import Effectful.Log.Backend.StandardOutput
main :: IO ()
main = runEff $ do
runCurrentTimeIO . runSimpleStdOutLogging "main" LogInfo $ do
app
app :: (Logging :> es, Time :> es) => Eff es ()
app = do
logInfo "Hello !" ("Some JSON payload" :: Text)
```
[effectful]: https://github.com/arybczak/effectful
[effectful-time]: https://github.com/Kleidukos/effectful-contrib/effectful-time
[log-base]: https://hackage.haskell.org/package/log-base

80
effectful-log-base/effectful-log-base.cabal
View File

@ -1,80 +0,0 @@
cabal-version: 3.0
name: effectful-log-base
version: 0.0.1.0
homepage: https://github.com/Kleidukos/effectful-contrib#readme
bug-reports: https://github.com/Kleidukos/effectful-contrib/issues
author: Dominik Peteler
maintainer: Dominik Peteler
license: BSD-3-Clause
build-type: Simple
extra-source-files:
CHANGELOG.md
LICENSE.md
README.md
source-repository head
type: git
location: https://github.com/Kleidukos/effectful-contrib
common language
ghc-options: -Wall -Wcompat
default-language: Haskell2010
default-extensions: DataKinds
FlexibleContexts
GADTs
KindSignatures
TypeFamilies
TypeOperators
library
import: language
ghc-options: -O2
hs-source-dirs: src
exposed-modules:
Effectful.Log
Effectful.Log.Logger
Effectful.Log.Backend.LogList
Effectful.Log.Backend.StandardOutput
Effectful.Log.Backend.StandardOutput.Bulk
Effectful.Log.Backend.Text
build-depends: base <= 4.17
, aeson
, bytestring
, effectful-core
, effectful-time
, log-base >= 0.11.0.0
, text
, time
test-suite effectful-log-base-test
import: language
type: exitcode-stdio-1.0
hs-source-dirs:
examples
test
main-is: Main.hs
build-depends: base
, aeson
, effectful
, effectful-core
, effectful-log-base
, effectful-time
, hspec
, log-base
, text
other-modules:
StdoutExample
Utils
ghc-options: -rtsopts -threaded -with-rtsopts=-N

20
effectful-log-base/examples/StdoutExample.hs
View File

@ -1,20 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module StdoutExample (main) where
import Data.Text (Text)
import Effectful.Monad
import Effectful.Time (Time, runCurrentTimeIO)
import Log (LogLevel(LogInfo), logInfo)
import Effectful.Log
import Effectful.Log.Backend.StandardOutput
main :: IO ()
main = runEff $ do
runCurrentTimeIO . runSimpleStdOutLogging "main" LogInfo $ do
app
app :: (Logging :> es, Time :> es) => Eff es ()
app = do
logInfo "Hello !" ("Some JSON payload" :: Text)

130
effectful-log-base/src/Effectful/Log.hs
View File

@ -1,130 +0,0 @@
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Effectful.Log
( -- * Logging effect
Logging
, runLogging
, runLoggingWithEnv
-- * Effectful functions of 'LogBase.Monad'
, logMessageEff
, getLoggerEff
-- * 'LogBase.MonadLog' methods specialized to `Eff`
, logMessageEff'
, localDataEff'
, localDomainEff'
, localMaxLogLevelEff'
, getLoggerEnvEff'
) where
import Data.Aeson.Types (Pair, Value)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Effectful.Dispatch.Static
import Effectful.Monad
import Effectful.Time (Time, getCurrentTime)
import Log (Logger, LoggerEnv, LogLevel, MonadLog)
import qualified Log as LogBase
-- | An effect for structured logging using the @log-base@ library.
data Logging :: Effect
type instance DispatchOf Logging = 'Static
newtype instance StaticRep Logging = Logging LoggerEnv
-- | Run a 'Logging' effect.
--
-- This function is the effectful version of 'LogBase.runLogT'.
runLogging
:: IOE :> es
=> Text
-- ^ Application component name to use.
-> Logger
-- ^ The logging back-end to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runLogging component logger maxLogLevel = runLoggingWithEnv LogBase.LoggerEnv
{ LogBase.leLogger = logger
, LogBase.leComponent = component
, LogBase.leDomain = []
, LogBase.leData = []
, LogBase.leMaxLogLevel = maxLogLevel
}
-- | Run a 'Logging' effect with a given logging environment.
runLoggingWithEnv
:: IOE :> es
=> LoggerEnv
-- ^ The logging environment to use.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runLoggingWithEnv logEnv = evalStaticRep (Logging logEnv)
----------------------------------------
-- Effectful 'LogBase.MonadLog' methods
-- | A specialized version of 'LogBase.logMessage'.
logMessageEff'
:: (Logging :> es, Time :> es)
=> LogLevel
-> Text
-> Value
-> Eff es ()
logMessageEff' level message data_ = do
time <- getCurrentTime
Logging logEnv <- getStaticRep
unsafeEff_ $ LogBase.logMessageIO logEnv time level message data_
-- | A specialized version of 'LogBase.localData'.
localDataEff' :: Logging :> es => [Pair] -> Eff es a -> Eff es a
localDataEff' data_ = localStaticRep $ \(Logging logEnv) ->
Logging logEnv { LogBase.leData = data_ ++ LogBase.leData logEnv }
-- | A specialized version of 'LogBase.localDomain'.
localDomainEff' :: Logging :> es => Text -> Eff es a -> Eff es a
localDomainEff' domain = localStaticRep $ \(Logging logEnv) ->
Logging logEnv { LogBase.leDomain = LogBase.leDomain logEnv ++ [domain] }
-- | A specialized version of 'LogBase.localMaxLogLevel'.
localMaxLogLevelEff' :: Logging :> es => LogLevel -> Eff es a -> Eff es a
localMaxLogLevelEff' level = localStaticRep $ \(Logging logEnv) ->
Logging logEnv { LogBase.leMaxLogLevel = level }
-- | A specialized version of 'LogBase.getLoggerEnv'.
getLoggerEnvEff' :: Logging :> es => Eff es LoggerEnv
getLoggerEnvEff' = do
Logging env <- getStaticRep
pure env
----------------------------------------
-- Effectful functions of 'LogBase.Monad'
logMessageEff :: IOE :> es => LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> Eff es ()
logMessageEff logEnv time level message data_ =
unsafeEff_ $ LogBase.logMessageIO logEnv time level message data_
getLoggerEff
:: (IOE :> es', Logging :> es)
=> Eff es (UTCTime -> LogLevel -> Text -> Value -> Eff es' ())
getLoggerEff = logMessageEff <$> getLoggerEnvEff'
----------------------------------------
-- Orphan instances for 'Eff'
instance (Logging :> es, Time :> es) => MonadLog (Eff es) where
logMessage = logMessageEff'
localData = localDataEff'
localDomain = localDomainEff'
localMaxLogLevel = localMaxLogLevelEff'
getLoggerEnv = getLoggerEnvEff'

66
effectful-log-base/src/Effectful/Log/Backend/LogList.hs
View File

@ -1,66 +0,0 @@
-- | LogList logging back-end.
module Effectful.Log.Backend.LogList
( -- * Logging to lists
runLogListLogging
-- * Bindings
, newLogList
, getLogList
, putLogList
, clearLogList
, withLogListLogger
-- Re-exports
, LogBase.LogList
) where
import Data.Text (Text)
import Effectful.Dispatch.Static
import Effectful.Monad
import Log (LogLevel, LogMessage)
import Log.Backend.LogList (LogList)
import qualified Log.Backend.LogList as LogBase
import Effectful.Log
import Effectful.Log.Logger
-- | A handler for the 'Logging' effect that is logging to a 'LogList'.
--
-- Implemented using 'LogBase.withLogListLogger'.
runLogListLogging
:: IOE :> es
=> LogList
-> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runLogListLogging ll component maxLogLevel k =
withLogListLogger ll $ \logger -> do
runLogging component logger maxLogLevel k
----------------------------------------
-- Bindings
-- | Lifted 'LogBase.newLogList'.
newLogList :: IOE :> es => Eff es LogList
newLogList = unsafeEff_ LogBase.newLogList
-- | Lifted 'LogBase.getLogList'.
getLogList :: IOE :> es => LogList -> Eff es [LogMessage]
getLogList = unsafeEff_ . LogBase.getLogList
-- | Lifted 'LogBase.putLogList'.
putLogList :: IOE :> es => LogList -> LogMessage -> Eff es ()
putLogList ll = unsafeEff_ . LogBase.putLogList ll
-- | Lifted 'LogBase.clearLogList'
clearLogList :: IOE :> es => LogList -> Eff es ()
clearLogList = unsafeEff_ . LogBase.clearLogList
-- | Lifted 'LogBase.withLogListLogger'.
withLogListLogger :: IOE :> es => LogList -> (Logger -> Eff es a) -> Eff es a
withLogListLogger ll f = unsafeEff $ \es -> do
LogBase.withLogListLogger ll ((`unEff` es) . f)

101
effectful-log-base/src/Effectful/Log/Backend/StandardOutput.hs
View File

@ -1,101 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Stdout logging back-end.
module Effectful.Log.Backend.StandardOutput
( -- * Logging to stdout
runSimpleStdOutLogging
, runStdOutLogging
, runJsonStdOutLogging
-- * Bindings
, withSimpleStdOutLogger
, withStdOutLogger
, withJsonStdOutLogger
) where
import Data.Text (Text)
import qualified Data.Text.IO as Text
import Data.Aeson as JSON
import Effectful.Dispatch.Static
import Effectful.Monad
import Log (LogLevel)
import qualified Log as LogBase
import qualified Log.Backend.StandardOutput as LogBase
import System.IO (hFlush, stdout)
import qualified Data.ByteString.Lazy.Char8 as BSL
import Effectful.Log
import Effectful.Log.Logger
-- | A handler for the 'Logging' effect that is logging to stdout in a simple
-- format.
--
-- Implemented using 'LogBase.withSimpleStdOutLogger'.
runSimpleStdOutLogging
:: IOE :> es
=> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runSimpleStdOutLogging component maxLogLevel k =
withSimpleStdOutLogger $ \logger -> do
runLogging component logger maxLogLevel k
-- | A handler for the 'Logging' effect that is logging to stdout.
--
-- Implemented using 'LogBase.withStdOutLogger'.
runStdOutLogging
:: IOE :> es
=> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runStdOutLogging component maxLogLevel k = withStdOutLogger $ \logger -> do
runLogging component logger maxLogLevel k
-- | A handler for the 'Logging' effect that is logging to stdout in the JSON
-- format.
--
-- Implemented using 'LogBase.withJsonStdOutLogger'.
runJsonStdOutLogging
:: IOE :> es
=> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runJsonStdOutLogging component maxLogLevel k =
withJsonStdOutLogger $ \logger -> do
runLogging component logger maxLogLevel k
----------------------------------------
-- Bindings
-- | Lifted 'LogBase.withSimpleStdOutLogger'.
withSimpleStdOutLogger :: IOE :> es => (Logger -> Eff es a) -> Eff es a
withSimpleStdOutLogger act = unsafeEff $ \es -> do
LogBase.withSimpleStdOutLogger ((`unEff` es) . act)
-- | Lifted 'LogBase.withStdOutLogger'.
withStdOutLogger :: IOE :> es => (Logger -> Eff es a) -> Eff es a
withStdOutLogger act = do
logger <- mkLogger "stdout" $ \msg -> liftIO $ do
Text.putStrLn $ LogBase.showLogMessage Nothing msg
hFlush stdout
withLogger logger act
-- | Lifted 'LogBase.withJsonStdOutLogger'.
withJsonStdOutLogger :: IOE :> es => (Logger -> Eff es a) -> Eff es a
withJsonStdOutLogger act = do
logger <- mkLogger "stdout-json" $ \msg -> liftIO $ do
BSL.putStrLn $ JSON.encode msg
hFlush stdout
withLogger logger act

85
effectful-log-base/src/Effectful/Log/Backend/StandardOutput/Bulk.hs
View File

@ -1,85 +0,0 @@
{-# LANGUAGE OverloadedStrings#-}
-- | Bulk stdout logging back-end.
module Effectful.Log.Backend.StandardOutput.Bulk
( -- * Bulk logging to stdout
runBulkStdOutLogging
, runBulkJsonStdOutLogging
-- * Bindings
, withBulkStdOutLogger
, withBulkJsonStdOutLogger
) where
import qualified Data.Aeson as JSON
import Data.Text (Text)
import qualified Data.Text.IO as Text
import qualified Data.ByteString.Lazy.Char8 as BSL
import Effectful.Monad
import Log (LogLevel)
import qualified Log as LogBase
import System.IO (hFlush, stdout)
import Effectful.Log
import Effectful.Log.Logger
-- | A handler for the 'Logging' effect that is logging to stdout once per
-- second.
--
-- Implemented using 'LogBase.withBulkStdOutLogger'.
runBulkStdOutLogging
:: IOE :> es
=> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runBulkStdOutLogging component maxLogLevel k =
withBulkStdOutLogger $ \logger -> do
runLogging component logger maxLogLevel k
-- | A handler for the 'Logging' effect that is logging to stdout in the JSON
-- format once per second.
--
-- Implemented using 'LogBase.withBulkJsonStdOutLogger'.
runBulkJsonStdOutLogging
:: IOE :> es
=> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runBulkJsonStdOutLogging component maxLogLevel k =
withBulkJsonStdOutLogger $ \logger -> do
runLogging component logger maxLogLevel k
----------------------------------------
-- Bindings
-- | Lifted 'LogBase.withBulkStdOutLogger'.
withBulkStdOutLogger :: IOE :> es => (Logger -> Eff es a) -> Eff es a
withBulkStdOutLogger act = do
logger <- mkBulkLogger "stdout-bulk" exec cleanup
withLogger logger act
where
exec msgs = liftIO $ do
mapM_ (Text.putStrLn . LogBase.showLogMessage Nothing) msgs
hFlush stdout
cleanup = return ()
-- | Lifted 'LogBase.withBulkJsonStdOutLogger'.
withBulkJsonStdOutLogger :: IOE :> es => (Logger -> Eff es a) -> Eff es a
withBulkJsonStdOutLogger act = do
logger <- mkBulkLogger "stdout-bulk-json" exec cleanup
withLogger logger act
where
exec msgs = liftIO $ do
mapM_ (BSL.putStrLn . JSON.encode) msgs
hFlush stdout
cleanup = return ()

43
effectful-log-base/src/Effectful/Log/Backend/Text.hs
View File

@ -1,43 +0,0 @@
-- | A logger that produces in-memory 'Text' values. Mainly useful for
-- testing.
module Effectful.Log.Backend.Text
( -- * Logging to an in-memory text value
runSimpleTextLogging
-- * Bindings
, withSimpleTextLogger
) where
import Data.Text (Text)
import Effectful.Dispatch.Static
import Effectful.Monad
import Log (LogLevel)
import qualified Log.Backend.Text as LogBase
import Effectful.Log
import Effectful.Log.Logger
-- | A handler for the 'Logging' effect that is logging to an in-memory 'Text'
-- value.
--
-- Implemented using 'LogBase.withSimpleTextLogger'.
runSimpleTextLogging
:: IOE :> es
=> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es (Text, a)
runSimpleTextLogging component maxLogLevel k =
withSimpleTextLogger $ \logger -> do
runLogging component logger maxLogLevel k
----------------------------------------
-- Bindings
-- | Lifted 'LogBase.withSimpleTextLogger'.
withSimpleTextLogger :: (Logger -> Eff es a) -> Eff es (Text, a)
withSimpleTextLogger act = unsafeEff $ \es -> do
LogBase.withSimpleTextLogger ((`unEff` es) . act)

63
effectful-log-base/src/Effectful/Log/Logger.hs
View File

@ -1,63 +0,0 @@
module Effectful.Log.Logger
( -- * Creating loggers
mkLogger
, mkLogger'
, mkBulkLogger
, mkBulkLogger'
-- * Helper functions from 'Log.Internal.Logger'
, withLogger
-- * Re-exports
, Logger
) where
import Data.Text (Text)
import Log (Logger, LogMessage)
import qualified Log as LogBase
import qualified Log.Internal.Logger as LogBase
import Effectful.Dispatch.Static
import Effectful.Monad
-- | Lifted 'LogBase.mkLogger'.
mkLogger :: IOE :> es => Text -> (LogMessage -> Eff es ()) -> Eff es Logger
mkLogger name exec = unsafeEff $ \es -> do
es' <- cloneEnv es
LogBase.mkLogger name ((`unEff` es') . exec)
-- | Lifted `LogBase.mkLogger'`.
mkLogger' :: IOE :> es => Int -> Text -> (LogMessage -> Eff es ()) -> Eff es Logger
mkLogger' cap name exec = unsafeEff $ \es -> do
es' <- cloneEnv es
LogBase.mkLogger' cap name ((`unEff` es') . exec)
-- | Lifted 'LogBase.mkBulkLogger'.
mkBulkLogger :: IOE :> es => Text -> ([LogMessage] -> Eff es ()) -> Eff es () -> Eff es Logger
mkBulkLogger name exec cleanup = unsafeEff $ \es -> do
es' <- cloneEnv es
LogBase.mkBulkLogger name ((`unEff` es') . exec) (unEff cleanup es')
-- | Lifted `LogBase.mkBulkLogger'`.
mkBulkLogger'
:: IOE :> es
=> Int
-- ^ queue capacity (default 1000000)
-> Int
-- ^ thread delay (microseconds, default 1000000)
-> Text
-- ^ logger name
-> ([LogMessage] -> Eff es ())
-- ^ write
-> Eff es ()
-- ^ flush
-> Eff es Logger
mkBulkLogger' cap dur name exec cleanup = unsafeEff $ \es -> do
es' <- cloneEnv es
LogBase.mkBulkLogger' cap dur name ((`unEff` es') . exec) (unEff cleanup es')
----------------------------------------
-- Helper functions from 'Log.Internal.Logger'
withLogger :: IOE :> es => Logger -> (Logger -> Eff es a) -> Eff es a
withLogger logger f = unsafeEff $ \es -> do
LogBase.withLogger logger ((`unEff` es) . f)

134
effectful-log-base/test/Main.hs
View File

@ -1,134 +0,0 @@
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Main (main) where
import Data.Aeson (Value(..))
import Data.Text (Text)
import Effectful.Monad
import Effectful.Time
import Log
import Test.Hspec hiding (shouldBe)
import Effectful.Log
import Effectful.Log.Backend.LogList
import Utils
import StdoutExample ()
default (Text)
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "MonadLog functions" $ do
it "logMessage" testLogMessage
it "localData" testLocalData
it "localDomain" testLocalDomain
it "localMaxLogLevel" testLocalMaxLogLevel
testLogMessage :: Expectation
testLogMessage = runEff $ do
msgs <- logTestWith "main" LogInfo $ do
logMessage LogInfo "Message 1" Null
logMessage LogTrace "Message 2" Null
logMessage LogInfo "Message 3" Null
msgs `shouldBe`
[ message1
, message3
]
testLocalData :: Expectation
testLocalData = runEff $ do
msgs <- logTestWith "main" LogInfo $ do
logMessage LogInfo "Message 1" Null
localData [ "key" .= "value" ] $ do
logMessage LogInfo "Message 2" Null
logMessage LogInfo "Message 3" Null
msgs `shouldBe`
[ message1
, message2
{ lmData = object
[ "__data_null" .= Null
, "key" .= "value"
]
}
, message3
]
testLocalDomain :: Expectation
testLocalDomain = runEff $ do
msgs <- logTestWith "main" LogInfo $ do
logMessage LogInfo "Message 1" Null
localDomain "local domain" $ do
logMessage LogInfo "Message 2" Null
logMessage LogInfo "Message 3" Null
msgs `shouldBe`
[ message1
, message2
{ lmDomain =
[ "local domain"
]
}
, message3
]
testLocalMaxLogLevel :: Expectation
testLocalMaxLogLevel = runEff $ do
msgs <- logTestWith "main" LogInfo $ do
logMessage LogInfo "Message 1" Null
localMaxLogLevel LogAttention $ do
logMessage LogInfo "Message 2" Null
logMessage LogInfo "Message 3" Null
msgs `shouldBe`
[ message1
, message3
]
----------------------------------------
-- Helpers
logTestWith
:: IOE :> es
=> Text
-> LogLevel
-> Eff (Logging : Time : es) ()
-> Eff es [LogMessage]
logTestWith component logLevel k = do
ll <- newLogList
withLogListLogger ll $ \logger -> do
runCurrentTimePure epoch . runLogging component logger logLevel $ k
getLogList ll
epoch :: UTCTime
epoch = read "1970-01-01 00:00:00 UTC"
message :: LogMessage
message = LogMessage
{ lmComponent = "main"
, lmDomain = []
, lmTime = epoch
, lmLevel = LogInfo
, lmMessage = "Message"
, lmData = object [ "__data_null" .= Null ]
}
message1 :: LogMessage
message1 = message
{ lmMessage = "Message 1"
}
message2 :: LogMessage
message2 = message
{ lmMessage = "Message 2"
}
message3 :: LogMessage
message3 = message
{ lmMessage = "Message 3"
}

11
effectful-log-base/test/Utils.hs
View File

@ -1,11 +0,0 @@
module Utils where
import Control.Monad.IO.Class
import Effectful.Monad
import GHC.Stack
import qualified Test.Hspec as H
shouldBe :: (HasCallStack, Eq a, Show a, IOE :> es)
=> a -> a -> Eff es ()
shouldBe expected given = liftIO $ expected `H.shouldBe` given

4
effectful-log-elasticsearch/CHANGELOG.md
View File

@ -1,4 +0,0 @@
# CHANGELOG
## v0.0.1.0 –
* Release

20
effectful-log-elasticsearch/README.md
View File

@ -1,20 +0,0 @@
# effectful-log-elasticsearch
## Description
This package provides an [ElasticSearch][elasticsearch] logging backend for the
[`effectful-log-base`][effectful-log-base] library.
It contains a handler for the `Logging` effect and versions of the functions
found in the [`log-elasticsearch`][log-elasticsearch] package lifted to the
`Eff` monad of the [effectful][effectful] library.
## How to use
See the documentation of the
[`effectful-log-base`](./effectful-log-base#readme) package on how to use
logging backends.
[effectful]: https://github.com/arybczak/effectful
[effectful-log-base]: ./effectful-log-base
[elasticsearch]: https://www.elastic.co/elasticsearch/
[log-elasticsearch]: https://hackage.haskell.org/package/log-elasticsearch

44
effectful-log-elasticsearch/effectful-log-elasticsearch.cabal
View File

@ -1,44 +0,0 @@
cabal-version: 3.0
name: effectful-log-elasticsearch
version: 0.0.1.0
homepage: https://github.com/Kleidukos/effectful-contrib#readme
bug-reports: https://github.com/Kleidukos/effectful-contrib/issues
author: Dominik Peteler
maintainer: Dominik Peteler
license: BSD-3-Clause
build-type: Simple
extra-source-files:
CHANGELOG.md
LICENSE.md
README.md
source-repository head
type: git
location: https://github.com/Kleidukos/effectful-contrib
common language
ghc-options: -Wall -Wcompat
default-language: Haskell2010
default-extensions: DataKinds
FlexibleContexts
TypeOperators
library
import: language
ghc-options: -O2
hs-source-dirs: src
exposed-modules:
Effectful.Log.Backend.ElasticSearch
build-depends: base <= 4.17
, effectful-core
, effectful-log-base
, http-client
, log-base
, log-elasticsearch >= 0.10.0.0
, text

63
effectful-log-elasticsearch/src/Effectful/Log/Backend/ElasticSearch.hs
View File

@ -1,63 +0,0 @@
-- | Elasticsearch logging back-end.
module Effectful.Log.Backend.ElasticSearch
( -- * Logging to an ElasticSearch endpoint
runElasticSearchLogging
-- * Bindings
, checkElasticSearchLogin
, checkElasticSearchConnection
, withElasticSearchLogger
-- Re-exports
, Log.ElasticSearchConfig
, Log.defaultElasticSearchConfig
, Log.esServer
, Log.esIndex
, Log.esShardCount
, Log.esReplicaCount
, Log.esMapping
, Log.esLogin
, Log.esLoginInsecure
) where
import Data.Text (Text)
import Effectful.Dispatch.Static
import Effectful.Log (Logging, runLogging)
import Effectful.Log.Logger (Logger)
import Effectful.Monad
import Log.Backend.ElasticSearch (ElasticSearchConfig)
import qualified Log.Backend.ElasticSearch as Log
import Log.Data (LogLevel)
import Network.HTTP.Client (HttpException)
-- | A handler for the 'Logging' effect using an ElasticSearch endpoint as a
-- backend.
runElasticSearchLogging
:: IOE :> es
=> ElasticSearchConfig
-> Text
-- ^ Application component name to use.
-> LogLevel
-- ^ The maximum log level allowed to be logged.
-> Eff (Logging : es) a
-- ^ The computation to run.
-> Eff es a
runElasticSearchLogging conf component maxLogLevel k =
withElasticSearchLogger conf $ \logger -> do
runLogging component logger maxLogLevel k
----------------------------------------
-- Bindings
-- | Lifted 'Log.checkElasticSearchLogin'.
checkElasticSearchLogin :: IOE :> es => ElasticSearchConfig -> Eff es ()
checkElasticSearchLogin = unsafeEff_ . Log.checkElasticSearchLogin
-- | Lifted 'Log.checkElasticSearchConnection'.
checkElasticSearchConnection :: IOE :> es => ElasticSearchConfig -> Eff es (Either HttpException ())
checkElasticSearchConnection = unsafeEff_ . Log.checkElasticSearchConnection
-- | Lifted 'Log.withElasticSearchLogger'.
withElasticSearchLogger :: IOE :> es => ElasticSearchConfig -> (Logger -> Eff es a) -> Eff es a
withElasticSearchLogger conf f = unsafeEff $ \es -> do
Log.withElasticSearchLogger conf ((`unEff` es) . f)

3
effectful-time/.gitignore vendored
View File

@ -1,3 +0,0 @@
dist-newstyle
.hie
.hspec-failures

4
effectful-time/CHANGELOG.md
View File

@ -1,4 +0,0 @@
# CHANGELOG
## v0.0.1.0 –
* Release

42
effectful-time/README.md
View File

@ -1,42 +0,0 @@
# effectful-time
## Description
A `Time` effect for the [`effectful`][effectful] ecosystem.
## How to use
This library exposes the following elements:
* `Time` — The type-level effect that you can declare in your type signatures.
example:
```haskell
processTime :: (Time :> es) => Eff es UTCTime
```
* `getCurrentTime` — The function that you will call to get a `Eff es UTCTime`.
```haskell
import qualified Data.Time as T
import Effectful.Time
usingTime :: (Time :> es) => Eff es UTCTime
usingTime = do
t <- getCurrentTime
pure $ T.addUTCTime 100 t
```
* Runners for IO & Pure environments:
```Haskell
runCurrentTimeIO usingTime
-- or
runCurrentTimePure (time :: UTCTime) usingTime
```
See the [tests][tests] to see an example use.
[effectful]: https://github.com/arybczak/effectful
[tests]: https://github.com/Kleidukos/effectful-contrib/blob/main/effectful-time/test/Main.hs

93
effectful-time/effectful-time.cabal
View File

@ -1,93 +0,0 @@
cabal-version: 3.0
name: effectful-time
version: 0.0.1.0
homepage: https://github.com/Kleidukos/effectful-contrib/tree/main/effectful-time#readme
bug-reports: https://github.com/Kleidukos/effectful-contrib/issues
author: Hécate Moonlight
maintainer: Hécate Moonlight
license: MIT
build-type: Simple
extra-source-files:
CHANGELOG.md
LICENSE.md
README.md
source-repository head
type: git
location: https://github.com/Kleidukos/effectful-contrib
common common-extensions
default-extensions: ConstraintKinds
DataKinds
DeriveAnyClass
DeriveGeneric
DerivingStrategies
DerivingVia
DuplicateRecordFields
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
InstanceSigs
KindSignatures
MultiParamTypeClasses
NamedFieldPuns
OverloadedStrings
RankNTypes
RecordWildCards
ScopedTypeVariables
StandaloneDeriving
TypeApplications
TypeFamilies
TypeOperators
default-language: Haskell2010
common common-ghc-options
ghc-options: -Wall
-Wcompat
-Werror
-Widentities
-Wincomplete-record-updates
-Wincomplete-uni-patterns
-Wpartial-fields
-Wredundant-constraints
-fhide-source-paths
-Wno-unused-do-bind
-fwrite-ide-info
-hiedir=.hie
-haddock
-j
common common-rts-options
ghc-options: -rtsopts
-threaded
-with-rtsopts=-N
library
import: common-extensions
import: common-ghc-options
hs-source-dirs:
src
exposed-modules:
Effectful.Time
build-depends:
base <= 4.17,
time,
effectful-core
test-suite effectful-time-test
import: common-extensions
import: common-ghc-options
import: common-rts-options
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules:
Utils
hs-source-dirs:
test
build-depends:
, base
, effectful-time
, effectful-core
, time
, hspec

48
effectful-time/src/Effectful/Time.hs
View File

@ -1,48 +0,0 @@
{-|
Module : Effectful.Time
Copyright : © Hécate Moonlight, 2021
License : MIT
Maintainer : hecate@glitchbra.in
Stability : stable
An effect wrapper around Data.Time for the Effectful ecosystem
-}
module Effectful.Time
(
-- * Time Effect
Time(..)
, UTCTime
, getCurrentTime
-- * Runners
, runCurrentTimeIO
, runCurrentTimePure
) where
import Control.Monad.IO.Class
import Data.Kind
import Data.Time (UTCTime)
import Effectful.Dispatch.Dynamic
import Effectful.Monad
import qualified Data.Time as T
-- | An effect for getting the current time
data Time :: Effect where
CurrentTime :: Time m UTCTime
type instance DispatchOf Time = 'Dynamic
-- | Retrieve the current time in your effect stack
getCurrentTime :: forall (es :: [Effect])
. Time :> es => Eff es UTCTime
getCurrentTime = send CurrentTime
-- | The default IO handler
runCurrentTimeIO :: forall (es :: [Effect]) (a :: Type)
. IOE :> es => Eff (Time : es) a -> Eff es a
runCurrentTimeIO = interpret $ \_ CurrentTime -> liftIO T.getCurrentTime
-- | The pure handler, with a static value
runCurrentTimePure :: forall (es :: [Effect]) (a :: Type)
. UTCTime -> Eff (Time : es) a -> Eff es a
runCurrentTimePure time = interpret $ \_ CurrentTime -> pure time

58
effectful-time/test/Main.hs
View File

@ -1,58 +0,0 @@
module Main where
import qualified Data.Time as T
import Debug.Trace
import Effectful.Monad
import Effectful.State.Local
import Test.Hspec as H
import qualified Utils as U
import Effectful.Time
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "Combining State & Time" $ do
it "IO Time handler & State" $ testIOTimeAndState =<< T.getCurrentTime
it "Pure Time handler & State" testPureTimeAndState
---
testIOTimeAndState :: UTCTime -> Expectation
testIOTimeAndState firstTime = runEff $ do
traceShowM firstTime
result <- evalState firstTime -- The order in which thes two functions
. runCurrentTimeIO -- are composed does not matter. Swap them to try.
$ storingTimeInState
result `U.shouldBe` firstTime
storingTimeInState :: (Time :> es, State UTCTime :> es) => Eff es UTCTime
storingTimeInState = do
firstTime <- get
secondTime <- action
if secondTime <= firstTime
then put secondTime
else put firstTime
get
action :: (Time :> es) => Eff es UTCTime
action = do
T.addUTCTime 100 <$> getCurrentTime
---
testPureTimeAndState :: Expectation
testPureTimeAndState = runEff $ do
let time = read "2021-07-11 13:30:20 UTC" :: UTCTime
result <- runCurrentTimePure time
. evalState time
$ usingStaticTime
result `U.shouldBe` True
usingStaticTime :: (Time :> es, State UTCTime :> es) => Eff es Bool
usingStaticTime = do
t <- getCurrentTime
t' <- get
pure $ t == t'

11
effectful-time/test/Utils.hs
View File

@ -1,11 +0,0 @@
module Utils where
import Control.Monad.IO.Class
import Effectful.Monad
import GHC.Stack
import qualified Test.Hspec as H
shouldBe :: (HasCallStack, Eq a, Show a, IOE :> es)
=> a -> a -> Eff es ()
shouldBe expected given = liftIO $ expected `H.shouldBe` given

4
effectful-typed-process/CHANGELOG.md
View File

@ -1,4 +0,0 @@
# CHANGELOG
## v0.0.1.0 –
* Release

30
effectful-typed-process/README.md
View File

@ -1,30 +0,0 @@
# effectful-typed-process
## Description
An alternative `Process` effect for the [`effectful`][effectful] ecosystem.
While to the `Process` effect shipped with the `effectful` library is based on
the [`process`][process] package this implementation relies on
[`typed-process`][typed-process] instead.
## How to use
The functions exposed by the `Effectful.Process.Typed` module are those from
[`System.Process.Typed`](https://hackage.haskell.org/package/typed-process-0.2.6.1/docs/System-Process-Typed.html)
with the notable difference that they have a `TypedProcess :> es` constraint.
Use `runTypedProcess` to handle the effect and eliminate the constraint.
```haskell
import Effectful.Monad
import Effectful.Process.Typed
main :: IO ()
main = runEff . runTypedProcess $ true
true :: TypedProcess :> es => Eff es ()
true = Effectful.Process.Typed.runProcess_ $ shell "true"
```
[effectful]: https://github.com/arybczak/effectful
[process]: https://hackage.haskell.org/package/process
[typed-process]: https://hackage.haskell.org/package/typed-process

60
effectful-typed-process/effectful-typed-process.cabal
View File

@ -1,60 +0,0 @@
cabal-version: 3.0
name: effectful-typed-process
version: 0.0.1.0
homepage: https://github.com/Kleidukos/effectful-contrib#readme
bug-reports: https://github.com/Kleidukos/effectful-contrib/issues
author: Dominik Peteler
maintainer: Dominik Peteler
license: BSD-3-Clause
build-type: Simple
extra-source-files:
CHANGELOG.md
LICENSE.md
README.md
source-repository head
type: git
location: https://github.com/Kleidukos/effectful-contrib
common language
ghc-options: -Wall -Wcompat
default-language: Haskell2010
default-extensions: DataKinds
FlexibleContexts
GADTs
KindSignatures
TypeFamilies
TypeOperators
library
import: language
ghc-options: -rtsopts -threaded -with-rtsopts=-N
hs-source-dirs: src
exposed-modules:
Effectful.Process.Typed
build-depends: base <= 4.17
, bytestring
, typed-process
, effectful-core
test-suite effectful-typed-process-test
import: language
ghc-options: -rtsopts -threaded -with-rtsopts=-N
build-depends: base
, effectful
, effectful-core
, effectful-typed-process
, hspec
hs-source-dirs: test
type: exitcode-stdio-1.0
main-is: Main.hs

8
effectful-typed-process/example/Main.hs
View File

@ -1,8 +0,0 @@
import Effectful.Monad
import Effectful.Process.Typed
main :: IO ()
main = runEff . runTypedProcess $ true
true :: TypedProcess :> es => Eff es ()
true = Effectful.Process.Typed.runProcess_ $ shell "true"

221
effectful-typed-process/src/Effectful/Process/Typed.hs
View File

@ -1,221 +0,0 @@
{-# OPTIONS_GHC -fno-warn-dodgy-imports #-}
module Effectful.Process.Typed
( -- * Process effect
TypedProcess
, runTypedProcess
-- * Launch a process
, startProcess
, stopProcess
, withProcessWait
, withProcessWait_
, withProcessTerm
, withProcessTerm_
, readProcess
, readProcess_
, runProcess
, runProcess_
, readProcessStdout
, readProcessStdout_
, readProcessStderr
, readProcessStderr_
, readProcessInterleaved
, readProcessInterleaved_
-- * Process exit code
, waitExitCode
, getExitCode
, checkExitCode
-- * Re-exports from "System.Process.Typed"
, module Reexport
) where
import System.Process.Typed as Reexport hiding
( startProcess
, stopProcess
, withProcessWait
, withProcessWait_
, withProcessTerm
, withProcessTerm_
, readProcess
, readProcess_
, runProcess
, runProcess_
, readProcessStdout
, readProcessStdout_
, readProcessStderr
, readProcessStderr_
, readProcessInterleaved
, readProcessInterleaved_
, waitExitCode
, getExitCode
, checkExitCode
)
import Data.ByteString.Lazy (ByteString)
import Effectful.Dispatch.Static
import Effectful.Monad
import qualified System.Process.Typed as PT
-- | An effect for running child processes using the @typed-process@ library.
data TypedProcess :: Effect
type instance DispatchOf TypedProcess = 'Static
data instance StaticRep TypedProcess = TypedProcess
runTypedProcess :: IOE :> es => Eff (TypedProcess : es) a -> Eff es a
runTypedProcess = evalStaticRep TypedProcess
----------------------------------------
-- Launch a process
-- | Lifted 'PT.startProcess'.
startProcess :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderr
-> Eff es (PT.Process stdin stdout stderr)
startProcess = unsafeEff_ . PT.startProcess
-- | Lifted 'PT.stopProcess'.
stopProcess :: TypedProcess :> es => PT.Process stdin stdout stderr -> Eff es ()
stopProcess = unsafeEff_ . PT.stopProcess
-- | Lifted 'PT.withProcessWait'.
withProcessWait :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderr
-> (PT.Process stdin stdout stderr -> Eff es a)
-> Eff es a
withProcessWait = liftWithProcess PT.withProcessWait
-- | Lifted 'PT.withProcessWait_'.
withProcessWait_ :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderr
-> (PT.Process stdin stdout stderr -> Eff es a)
-> Eff es a
withProcessWait_ = liftWithProcess PT.withProcessWait_
-- | Lifted 'PT.withProcessTerm'.
withProcessTerm :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderr
-> (PT.Process stdin stdout stderr -> Eff es a)
-> Eff es a
withProcessTerm = liftWithProcess PT.withProcessTerm
-- | Lifted 'PT.withProcessTerm_'.
withProcessTerm_ :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderr
-> (PT.Process stdin stdout stderr -> Eff es a)
-> Eff es a
withProcessTerm_ = liftWithProcess PT.withProcessTerm_
-- | Lifted 'PT.readProcess'.
readProcess :: TypedProcess :> es
=> PT.ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ExitCode, ByteString, ByteString)
readProcess = unsafeEff_ . PT.readProcess
-- | Lifted 'PT.readProcess_'.
readProcess_ :: TypedProcess :> es
=> PT.ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ByteString, ByteString)
readProcess_ = unsafeEff_ . PT.readProcess_
-- | Lifted 'PT.runProcess'.
runProcess :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderr
-> Eff es ExitCode
runProcess = unsafeEff_ . PT.runProcess
-- | Lifted 'PT.runProcess_'.
runProcess_ :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderr
-> Eff es ()
runProcess_ = unsafeEff_ . PT.runProcess_
-- | Lifted 'PT.readProcessStdout'.
readProcessStdout :: TypedProcess :> es
=> PT.ProcessConfig stdin stdoutIgnored stderr
-> Eff es (ExitCode, ByteString)
readProcessStdout = unsafeEff_ . PT.readProcessStdout
-- | Lifted 'PT.readProcessStdout_'.
readProcessStdout_ :: TypedProcess :> es
=> PT.ProcessConfig stdin stdoutIgnored stderr
-> Eff es ByteString
readProcessStdout_ = unsafeEff_ . PT.readProcessStdout_
-- | Lifted 'PT.readProcessStderr'.
readProcessStderr :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderrIgnored
-> Eff es (ExitCode, ByteString)
readProcessStderr = unsafeEff_ . PT.readProcessStderr
-- | Lifted 'PT.readProcessStderr_'.
readProcessStderr_ :: TypedProcess :> es
=> PT.ProcessConfig stdin stdout stderrIgnored
-> Eff es ByteString
readProcessStderr_ = unsafeEff_ . PT.readProcessStderr_
-- | Lifted 'PT.readProcessInterleaved'.
readProcessInterleaved :: TypedProcess :> es
=> PT.ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ExitCode, ByteString)
readProcessInterleaved = unsafeEff_ . PT.readProcessInterleaved
-- | Lifted 'PT.readProcessInterleaved_'.
readProcessInterleaved_ :: TypedProcess :> es
=> PT.ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es ByteString
readProcessInterleaved_ = unsafeEff_ . PT.readProcessInterleaved_
----------------------------------------
-- Process exit code
-- | Lifted 'PT.waitExitCode'.
waitExitCode :: TypedProcess :> es
=> PT.Process stdin stdout stderr
-> Eff es ExitCode
waitExitCode = unsafeEff_ . PT.waitExitCode
---- | Lifted 'PT.waitExitCodeSTM'.
--waitExitCodeSTM :: TypedProcess :> es
-- => PT.Process stdin stdout stderr
-- -> Eff es ExitCode
--waitExitCodeSTM = unsafeEff_ . PT.waitExitCode
-- | Lifted 'PT.getExitCode'.
getExitCode :: TypedProcess :> es
=> PT.Process stdin stdout stderr
-> Eff es (Maybe ExitCode)
getExitCode = unsafeEff_ . PT.getExitCode
---- | Lifted 'PT.getExitCodeSTM'.
--getExitCodeSTM :: TypedProcess :> es
-- => PT.Process stdin stdout stderr
-- -> Eff es (Maybe ExitCode)
--getExitCodeSTM = unsafeEff_ . PT.getExitCodeSTM
-- | Lifted 'PT.checkExitCode'.
checkExitCode :: TypedProcess :> es
=> PT.Process stdin stdout stderr
-> Eff es ()
checkExitCode = unsafeEff_ . PT.checkExitCode
---- | Lifted 'PT.checkExitCodeSTM'.
--checkExitCodeSTM :: TypedProcess :> es
-- => PT.Process stdin stdout stderr
-- -> Eff es ()
--checkExitCodeSTM = unsafeEff_ . PT.checkExitCodeSTM
----------------------------------------
-- Helpers
liftWithProcess :: TypedProcess :> es
=> (PT.ProcessConfig stdin stdout stderr -> (PT.Process stdin stdout stderr -> IO a) -> IO a)
-> PT.ProcessConfig stdin stdout stderr
-> (PT.Process stdin stdout stderr -> Eff es a)
-> Eff es a
liftWithProcess k pc f = unsafeEff $ \es ->
seqUnliftIO es $ \runInIO ->
k pc (runInIO . f)

136
effectful-typed-process/test/Main.hs
View File

@ -1,136 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import Effectful.Monad
import Effectful.Temporary
import System.Exit (ExitCode(..))
import System.IO.Error (isDoesNotExistError)
import Test.Hspec as H
import Effectful.Process.Typed
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "Simple" $ do
it "/usr/bin/env true" $ do
let pc = proc "/usr/bin/env" ["true"]
action = runEff . runTypedProcess $ do
p <- startProcess pc
waitExitCode p
action `shouldReturn` ExitSuccess
it "Non-existent binary" $ do
let pc = proc "/bin/doesnotexist" []
action = runEff . runTypedProcess $ do
p <- startProcess pc
waitExitCode p
action `shouldThrow` isDoesNotExistError
it "Continue process execution" $ do
let pc = shell "sleep 3"
action = runEff . runTypedProcess $ do
p <- startProcess pc
getExitCode p
action `shouldReturn` Nothing
describe "Termination" $ do
it "Terminate process" $ do
let action = runEff . runTemporary . runTypedProcess $ do
withSystemTempFile "effectful-typed-process-test" $ \fp h -> do
let pc = setStdout (useHandleClose h)
$ shell "sleep 1; printf 'Output'"
withProcessTerm pc (const $ pure ())
liftIO $ readFile fp
action `shouldReturn` ""
it "Wait for process" $ do
let action = runEff . runTemporary . runTypedProcess $ do
withSystemTempFile "effectful-typed-process-test" $ \fp h -> do
let pc = setStdout (useHandleClose h)
$ shell "sleep 1; printf 'Output'"
withProcessWait pc (const $ pure ())
liftIO $ readFile fp
action `shouldReturn` "Output"
describe "Helper functions" $ do
it "runProcess" $ do
let pc = proc "/usr/bin/env" ["true"]
action = runEff . runTypedProcess $ do
runProcess pc
action `shouldReturn` ExitSuccess
it "runProcess_" $ do
let pc = proc "/usr/bin/env" ["true"]
action = runEff . runTypedProcess $ do
runProcess_ pc
action `shouldReturn` ()
it "readProcess" $ do
let pc = shell "printf 'stdout'; printf 'stderr' >&2"
action = runEff . runTypedProcess $ do
readProcess pc
action `shouldReturn` (ExitSuccess, "stdout", "stderr")
it "readProcess_" $ do
let pc = shell "printf 'stdout'; printf 'stderr' >&2"
action = runEff . runTypedProcess $ do
readProcess_ pc
action `shouldReturn` ("stdout", "stderr")
it "readProcessStdout" $ do
let pc = shell "printf 'Output'"
action = runEff . runTypedProcess $ do
readProcessStdout pc
action `shouldReturn` (ExitSuccess, "Output")
it "readProcessStdout_" $ do
let pc = shell "printf 'Output'"
action = runEff . runTypedProcess $ do
readProcessStdout_ pc
action `shouldReturn` "Output"
it "readProcessStderr" $ do
let pc = shell "printf 'Output' >&2"
action = runEff . runTypedProcess $ do
readProcessStderr pc
action `shouldReturn` (ExitSuccess, "Output")
it "readProcessStderr_" $ do
let pc = shell "printf 'Output' >&2"
action = runEff . runTypedProcess $ do
readProcessStderr_ pc
action `shouldReturn` "Output"
describe "Exit codes" $ do
it "runProcess_" $ do
let pc = proc "/usr/bin/env" ["false"]
action = runEff . runTypedProcess $ do
runProcess_ pc
action `shouldThrow` const @_ @ExitCodeException True
it "readProcess_" $ do
let pc = proc "/usr/bin/env" ["false"]
action = runEff . runTypedProcess $ do
readProcess_ pc
action `shouldThrow` const @_ @ExitCodeException True
it "readProcessStdout_" $ do
let pc = proc "/usr/bin/env" ["false"]
action = runEff . runTypedProcess $ do
readProcessStdout_ pc
action `shouldThrow` const @_ @ExitCodeException True
it "readProcessStderr_" $ do
let pc = proc "/usr/bin/env" ["false"]
action = runEff . runTypedProcess $ do
readProcessStderr_ pc
action `shouldThrow` const @_ @ExitCodeException True