Skip to content

Instantly share code, notes, and snippets.

View kephas's full-sized avatar

Pierre Thierry kephas

35 followers · 46 following
  • AUTOGRIFF
  • Strasbourg, France
  • X @kephasp
View GitHub Profile
@kephas
kephas / readevents.hs
Created April 2, 2024 10:39
Attempt at polymorphic interpreter for Polysemy
#! /usr/bin/env nix-shell
#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (p: [p.aeson p.polysemy p.polysemy-plugin])"
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
@kephas
kephas / Adhoc.hs
Created October 16, 2023 15:43
Type-safe refactoring with ad-hoc polymorphism
module Adhoc where
data ClientIdentifier
= Admin
| User String
deriving (Eq, Show)
data Settings = Settings
{settingAllowList :: [ClientIdentifier]}
deriving (Show)
@kephas
kephas / Adhoc.hs
Created October 14, 2023 18:19
Type-safe refactoring with ad-hoc polymorphism
module Adhoc where
@kephas
kephas / effectful0.hs
Created August 4, 2023 10:47
Effectful code with different orders of effects in effectful code
#! /usr/bin/env nix-shell
#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (p: [p.effectful p.effectful-th])"
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
@kephas
kephas / conditions.hs
Created March 27, 2023 10:08
Alternative to early return in Functional Programming
checkUserForPromotion :: User -> Either String User
checkUserForPromotion user =
case (user.age > 18, user.country, length user.purchases > 5) of
(True, France, True) -> Right (user { status = Vip })
(False, _, _) -> Left "trop jeune"
(True, _, False) -> Left "pas assez d'achats"
(True, _, True) -> Left "pas français"
@kephas
kephas / creer_doublon.php
Created October 21, 2019 16:10
<?php
function creer_doublon($max) {
$start = 1;
$nombres = range(1, $max);
array_push($nombres, rand(1, $max));
shuffle($nombres);
return $nombres;
}
print_r(creer_doublon(10));
@kephas
kephas / padded_binary.lisp
Last active March 21, 2019 14:52
Padded binary numbers in Common Lisp
(defun read-only-chars (stream chars)
(with-output-to-string (result)
(loop while (find (peek-char nil stream) chars)
do (princ (read-char stream) result))))
(set-dispatch-macro-character #\# #\! (lambda (stream subchar arg)
(parse-integer (remove #\_ (read-only-chars stream "01_")) :radix 2)))
@kephas
kephas / base.scm
Created December 12, 2012 00:16
Base 12
#lang racket
(define digits12 "0123456789AB")
(define digits12-list (string->list digits12))
(define (digit12->int digit)
(let loop ((digits digits12-list)
(result 0))
(if (char=? digit (first digits))
result
@kephas
kephas / hunchentoot-hello.lisp
Created November 29, 2011 23:08
Hello World for Hunchentoot
(ql:quickload "hunchentoot")
(use-package :hunchentoot)
(start (make-instance 'acceptor :port 8080))
(define-easy-handler (greet :uri "/hello") (name)
(format nil "<html><body><h1>Hello ~a!</h1></body></html>" name))
@kephas
kephas / while.lisp
Created August 5, 2011 02:12
Implementation of while in Common Lisp
; the most straightforward imperative implementation of the while
; control structure
(defmacro while1 (cond &body body)
(with-gensyms (cond-var)
`(do ((,cond-var ,cond ,cond))
((not ,cond-var))
,@body)))
; a functional implementation relying on TCO
(defmacro while2 (cond &body body)