summaryrefslogtreecommitdiff
path: root/com/simatime
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-11-02 15:33:13 -0700
committerBen Sima <ben@bsima.me>2019-11-02 15:33:13 -0700
commit9d114cfc773171b0a95bd4d2c39f1bb0eb783c8d (patch)
tree20766a760ed0141cf39153565e8552f6739c632d /com/simatime
parentd2a37f5de160160eadbacd7b8dc2567f78a0543d (diff)
rename everything back to caps to appease ghc
Diffstat (limited to 'com/simatime')
-rw-r--r--com/simatime/alpha.hs24
-rwxr-xr-xcom/simatime/bild.scm159
-rw-r--r--com/simatime/buildHaskellApp.nix90
-rwxr-xr-xcom/simatime/caplinks.scm45
-rw-r--r--com/simatime/core.scm112
-rw-r--r--com/simatime/dev/configuration.nix220
-rw-r--r--com/simatime/dev/hardware.nix34
-rw-r--r--com/simatime/fathom.nix109
-rw-r--r--com/simatime/firefox.nix12
-rw-r--r--com/simatime/git.nix18
-rw-r--r--com/simatime/go.hs100
-rw-r--r--com/simatime/hardware.nix6
-rw-r--r--com/simatime/idea/duree-pitch.org80
-rw-r--r--com/simatime/idea/flash.org36
-rw-r--r--com/simatime/keys/ben.pub1
-rw-r--r--com/simatime/keys/deploy.pub1
-rw-r--r--com/simatime/keys/nick.pub1
-rw-r--r--com/simatime/language/bs.hs12
-rw-r--r--com/simatime/language/bs/cli.hs52
-rw-r--r--com/simatime/language/bs/eval.hs241
-rw-r--r--com/simatime/language/bs/expr.hs154
-rw-r--r--com/simatime/language/bs/parser.hs121
-rw-r--r--com/simatime/language/bs/primitives.hs183
-rw-r--r--com/simatime/language/bs/repl.hs33
-rw-r--r--com/simatime/language/bs/test.hs2
-rw-r--r--com/simatime/mail.nix43
-rw-r--r--com/simatime/network.hs31
-rw-r--r--com/simatime/networking.nix36
-rw-r--r--com/simatime/nixpkgs.nix5
-rw-r--r--com/simatime/packages.nix12
-rw-r--r--com/simatime/repl.scm23
-rw-r--r--com/simatime/sema.hs12
-rw-r--r--com/simatime/shell.scm34
-rw-r--r--com/simatime/shuffle.hs122
-rw-r--r--com/simatime/string.scm24
-rw-r--r--com/simatime/users.nix33
-rw-r--r--com/simatime/web.nix41
-rw-r--r--com/simatime/znc.nix66
38 files changed, 0 insertions, 2328 deletions
diff --git a/com/simatime/alpha.hs b/com/simatime/alpha.hs
deleted file mode 100644
index 438b97a..0000000
--- a/com/simatime/alpha.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
--- | Commonly useful functions, a Prelude replacement.
-module Com.Simatime.Alpha (
- -- * Re-export Protolude
- module X
- -- * General functions
- , (/@)
- -- * Debugging tools
- , say
- -- * TODO: remove this
- , Prelude.read
- ) where
-
-import qualified Prelude
-import Protolude as X
-import Data.String
-
--- | Debugging printf
-say :: String -> IO ()
-say msg = putStrLn msg
-
--- | Alias for map, fmap, <$>
-(/@) :: Functor f => (a -> b) -> f a -> f b
-(/@) = fmap
diff --git a/com/simatime/bild.scm b/com/simatime/bild.scm
deleted file mode 100755
index d924b29..0000000
--- a/com/simatime/bild.scm
+++ /dev/null
@@ -1,159 +0,0 @@
-;;
-;; bild - a simple build tool
-;;
-;;; Notice:
-;;
-;; This is under active development. For now this is just a convenience wrapper
-;; around `nix build`. The below commentary describes how this tool *should*
-;; work.
-;;
-;;; Commentary:
-;;
-;; Design constraints
-;;
-;; - only input is a namespace, no subcommands, no packages
-;; - no need to write specific build rules
-;; - one rule for hs, one for rs, one for scm, and so on
-;; - no need to distinguish between exe and lib, just have a single output
-;; - never concerned with deployment/packaging - leave that to another tool (scp? tar?))
-;;
-;; Features
-;;
-;; - namespace maps to filesystem
-;; - no need for `bild -l` for listing available targets. Use `ls` or `tree`
-;; - you build namespaces, not files/modules/packages/etc
-;; - namespace maps to language modules
-;; - build settings can be set in the file comments
-;; - pwd is always considered the the source directory, no `src` vs `doc` etc.
-;; - build methods automaticatly detected with file extensions
-;; - flags modify the way to interact with the build
-;; - -s = jump into a shell and/or repl
-;; - -p = turn on profiling
-;; - -t = limit build by type
-;; - -e = exclude some regex in the ns tree
-;; - -o = optimize level
-;;
-;; Example Commands
-;;
-;; bild [-rpt] <target..>
-;;
-;; The general scheme is to build the things described by the targets. A target
-;; is a namespace. You can list as many as you want, but you must list at least
-;; one. It could just be `.` for the current directory. Build outputs will go
-;; into the _bild directory in the root of the project.
-;;
-;; bild biz.web
-;;
-;; Or `bild biz/web`. This shows building a file at ./biz/web.hs, this will
-;; translate to something like `ghc --make Biz.Web`.
-;;
-;; bild -r <target>
-;;
-;; Starts a repl/shell for target.
-;; - if target.hs, load ghci
-;; - if target.scm, load scheme repl
-;; - if target.clj, load a clojure repl
-;; - if target.nix, load nix-shell
-;; - and so on.
-;;
-;; bild -p <target>
-;;
-;; build target with profiling (if available)
-;;
-;; bild -t nix target
-;;
-;; only build target.nix, not target.hs and so on (in the case of multiple
-;; targets with the same name but different extension).
-;;
-;; Here is an example integration with GHC. Given the following command-line
-;; invocation to compile the namespace 'com.simatime.bild' which depends on
-;; 'com.simatime.lib':
-;;
-;; ghc com/simatime/bild.hs -i com/simatime/lib.hs -o _bild/bild -v \
-;; -main-is Com.Simatime.Bild.main
-;;
-;; The general template of which is:
-;;
-;; ghc <source> -i <deps..> -o <target> -main-is <target>.main
-;;
-;; Some definitions:
-;;
-;; - <source> is some source file
-;; - <deps..> is the stack of dependencies
-;; - <target> is the target namespace, indicated by 'bild <target>'
-;;
-;; To fill out the build template, we can parse the file for known
-;; namespaces. The general recipe is:
-;;
-;; 1. Create a list of namespaces in my git repo. This can be cached, or I can
-;; integrate with git somehow.
-;; 2. Read the <source> file corresponding to <target>
-;; 3. Look for 'import <namespace>', where <namespace> is a namespace in the
-;; aforementioned cache.
-;; 4. If found, then save current build as a continuation and compile
-;; <namespace>. Result gets put on the dependency stack
-;; 5. When finished, return to building <target>
-;;
-;; Once the build command template is filled out, we can create the nix expression.
-;;
-;; Questions
-;;
-;; - how to import (third-party) dependencies?
-;; 1 just don't have them...? yeah right
-;; 2 the target.nix could be the build description for target.hs
-;; 3 just use a default.nix for the com.whatever
-;; 4 have a deps.nix file
-;; 5 list them in the file with other settings
-;; - how to handle multiple output formats?
-;; - e.g. that ghcjs and ghc take the same input files...
-;; - say you have a .md file, you want to bild it to pdf, html, and more. What do?
-;; - i guess the nix file could return a set of drvs instead of a single drv
-;;
-;; TODO
-;; - stream output from 'nix build' subprocess
-;; - get rid of guile notes during execution
-;; - ns<->path macro
-;; - support list (scheme namespace) in ns<->path fns
-;;
-;;; Code:
-
-(define-module (com simatime bild)
- #:use-module ((ice-9 popen) #:prefix popen/)
- #:use-module ((ice-9 format) #:select (format))
- #:use-module ((ice-9 rdelim) #:prefix rdelim/)
- #:use-module ((com simatime shell) #:prefix sh/)
- #:use-module ((com simatime string) #:prefix string/)
- #:export (ns?
- ns->path
- path->ns
- main))
-
-(define-syntax fmt
- (syntax-rules ()
- ((fmt s args ...)
- (format #f s args ...))))
-
-(define (main args)
- (let* ((root (sh/exec "git rev-parse --show-toplevel"))
- (target (cadr args))
- (path (ns->path target)))
- (display (fmt ":: bild ~a...\r" target))
- (sh/exec (fmt "nix build -f ~a/default.nix ~a"
- root target))
- (display (fmt ":: bilt ~a" target))))
-
-(define ns? symbol?)
-
-(define (ns->path ns)
- (let ((to-path (lambda (s) (string/replace s #\. #\/))))
- (cond
- ((symbol? ns) (to-path (symbol->string ns)))
- ((string? ns) (to-path ns))
- (else (error "ns should be a string or symbol")))))
-
-(define (path->ns path)
- (let ((to-ns (lambda (s) (string/replace s #\/ #\.))))
- (cond
- ((symbol? path) (to-ns (symbol->string path)))
- ((string? path) (to-ns path))
- (else (error "path should be a string or symbol")))))
diff --git a/com/simatime/buildHaskellApp.nix b/com/simatime/buildHaskellApp.nix
deleted file mode 100644
index ff9c741..0000000
--- a/com/simatime/buildHaskellApp.nix
+++ /dev/null
@@ -1,90 +0,0 @@
-
-nixpkgs:
-
-{
- # the namespace. We can't figure this out with Nix code, but when we port to
- # guix/scheme we should be able to
- name
-, nick # a short name, for the executable
-, apex # compiled with ghc
-, aero # compiled with ghcjs
- # deps get passed to the compilers
-, deps
-
-}:
-
-with nixpkgs;
-
-let
- nsToPath = ns: builtins.toString (builtins.replaceStrings ["."] ["/"] ns);
- aeroPath = nsToPath aero;
- apexPath = nsToPath apex;
- basePath = lib.strings.removeSuffix "/Apex" apexPath;
-
- depsToPackageSet = packageSet: deps:
- map (s: builtins.getAttr s packageSet) deps;
-
- ghc865_ = pkgs.haskell.packages.ghc865.override (oldAttrs: {
- overrides = with pkgs.haskell.lib; self: super: {
- clay = dontCheck super.clay;
- };
- });
-
- ghc = ghc865_.ghcWithPackages (hp: depsToPackageSet hp
- (deps.both ++ deps.apex));
-
- # ghcjs-8.6.0.1
- ghcjs_ = pkgs.haskell.packages.ghcjs.override (oldAttrs: {
- overrides = with pkgs.haskell.lib; self: super: {
- clay = dontCheck super.clay;
- http-types = dontCheck super.http-types;
- tasty-quickcheck = dontCheck super.tasty-quickcheck;
- scientific = dontCheck super.scientific; # takes forever
- servant = dontCheck super.servant;
- comonad = dontCheck super.comonad;
- QuickCheck = dontCheck super.QuickCheck;
- };
- });
-
- ghcjs = ghcjs_.ghcWithPackages (hp:
- depsToPackageSet hp (deps.both ++ deps.aero));
-
-in {
- env = ghc // ghcjs // guile;
- app = stdenv.mkDerivation {
- name = name;
- version = "0";
- src = ../../.; # this is the git root
- nativeBuildInputs = [
- ghc ghcjs guile
- ];
- strictDeps = true;
- buildPhase = ''
- # capitalize paths for 'ghc --make'
- source .envrc
- guile -e '(com simatime caplinks)' -s ./com/simatime/caplinks.scm .
- #
- mkdir -p $out/{bin,static} ${basePath}
- #
- # compile with ghc
- #
- ${ghc}/bin/ghc -i. --make ${apexPath}.hs -main-is ${apex} \
- -o ${apexPath}
- #
- # compile with ghcjs
- #
- ${ghcjs}/bin/ghcjs -i. --make ${aeroPath}.hs -main-is ${aero} \
- -o ${aeroPath}
- #
- # optimize js output
- #
- ${pkgs.closurecompiler}/bin/closure-compiler \
- --compilation_level ADVANCED_OPTIMIZATIONS \
- --jscomp_off=checkVars \
- --externs=${aeroPath}.jsexe/all.js.externs \
- ${aeroPath}.jsexe/all.js > $out/static/${nick}.js
- '';
- # the install process was handled above
- installPhase = "exit 0";
- };
-}
diff --git a/com/simatime/caplinks.scm b/com/simatime/caplinks.scm
deleted file mode 100755
index 21f0b88..0000000
--- a/com/simatime/caplinks.scm
+++ /dev/null
@@ -1,45 +0,0 @@
-
-(define-module (com simatime caplinks)
- #:use-module ((ice-9 popen) #:prefix popen/)
- #:use-module ((com simatime string) #:prefix string/)
- #:use-module ((com simatime shell) #:prefix sh/)
- #:export (main get-all-nodes make-symlink))
-
-;; given a root directory, walk the tree and get a list of all the files. Then,
-;; for each file, symlink a capitalized version
-(define (main args)
- (let* ((root (cadr args))
- (files (get-all-nodes root)))
- (for-each (lambda (file)
- (display file)
- (move-file file (capitalize-file file)))
- files)
- (display root) (newline)
- (display "done moving files") (newline)
- (newline)))
-
-(define (get-all-nodes root)
- (filter (lambda (s) (not (equal? "" s)))
- (string-split (sh/stream
- (format #f "find ~a -name '*.hs*'" root))
- #\newline)))
-
-(define (capitalize-file file)
- (string-join (map string/capitalize (string-split file #\/))
- "/"))
-
-(define (butlast ls)
- (let ((len (length ls)))
- (list-head ls (- len 1))))
-
-(define (dir-for f)
- (string-join
- (butlast (string-split f #\/))
- "/"))
-
-(define (move-file here there)
- (display (format #f "~a -> ~a" here there))
- (newline)
- ;; make the directory tree for the link, if it doesn't already exist
- (system (format #f "mkdir -p ~a" (dir-for there)))
- (system (format #f "mv ~a ~a" here there)))
diff --git a/com/simatime/core.scm b/com/simatime/core.scm
deleted file mode 100644
index 155214c..0000000
--- a/com/simatime/core.scm
+++ /dev/null
@@ -1,112 +0,0 @@
-(define-module (com simatime core))
-
-(define (flip f) (lambda (x y) (f y x)))
-(define (curry f a) (lambda (b) (apply f (cons a (list b)))))
-(define pos?
- (curry < 0))
-
-(define neg?
- (curry > 0))
-
-(define (foldr f end lst)
- (if (null? lst)
- end
- (f (car lst) (foldr f end (cdr lst)))))
-
-(define (foldl f acc lst)
- (if (null? lst)
- acc
- (foldl f (f acc (car lst)) (cdr lst))))
-
-(define fold foldl)
-
-(define (unfold f init pred)
- (if (pred init)
- (cons init '())
- (cons init (unfold f (f init) pred))))
-
-(define (sum lst) (fold + 0 lst))
-(define (produce lst) (fold * 0 1 lst))
-
-(define count length)
-
-
-;;
-;; clojure-like stuff
-;;
-
-(define (pr . a)
- (for-each display args))
-
-(define (prn . a) (apply pr a) (newline))
-
-(define first
- "Return the first item in the collection."
- car)
-
-(define next
- "Returns a list of the items after the first."
- cadr)
-
-(define (second x)
- (first (next x)))
-
-(define (ffirst x)
- (first (first x)))
-
-(define (nnext x)
- (next (next)))
-
-(define (last coll)
- "Return the last time in coll, in linear time."
- (if (next coll)
- (last coll)
- (first coll)))
-
-(define (false? x)
- (eq? #f x))
-
-(define (true? x)
- (eq? #t x))
-
-(define nil 'nil)
-
-(define (nil? x)
- (eq? nil x))
-
-(define-syntax when-not
- (syntax-case
- (())))
-
-#|
-
-If I implement ML-like interface abstractions in scheme, what would it look like?
-
-
-;; seq
-
-(define-class <seq> () (_first))
-
-
-;; Functor
-
-(define-class <functor> ())
-
-(define-method (fmap (f <procedure>) (coll <functor>)))
-
-
-;; Applicative
-
-;; a -> f a
-(define-method (pure (a <any>)))
-
-;; f (a -> b) -> f a -> f b
-(define-method (<*> (f <procedure>) (a <applicative>) (b <applicative>)))
-
-;; f a -> f b -> f b
-(define-method (*> (a <applicative>) (b <applicative>)))
-
-;; f a -> f b -> f a
-(define-method (<* (a <applicative>) (b <applicative>)))
-
-|#
diff --git a/com/simatime/dev/configuration.nix b/com/simatime/dev/configuration.nix
deleted file mode 100644
index c096f85..0000000
--- a/com/simatime/dev/configuration.nix
+++ /dev/null
@@ -1,220 +0,0 @@
-{ config, lib, pkgs, ... }:
-
-{
- networking = {
- hostName = "lithium";
- hosts = {
- "::1" = [ "localhost" "ipv6-localhost" "ipv6-loopback" ];
- };
-
- firewall = {
- allowedTCPPorts = [
- 22 8000 8443 443 8080 8081 # std
- 500 10000 # no idea
- 8096 # emby
- 8112 # deluge
- ];
- allowedTCPPortRanges = [
- { from = 3000; to = 3100; } # dev stuff
- { from = 6000; to = 6999; } # torrents
- ];
- allowedUDPPortRanges = [
- { from = 6000; to = 6999; } # torrents
- ];
- checkReversePath = false;
- };
-
- };
-
- # Use the systemd-boot EFI boot loader.
- boot.loader.systemd-boot.enable = true;
- boot.loader.efi.canTouchEfiVariables = true;
- boot.enableContainers = true;
-
- boot.initrd.luks.devices = [
- {
- name = "root";
- device = "/dev/disk/by-uuid/a0160f25-e0e3-4af0-8236-3e298eac957a";
- preLVM = true;
- }
- ];
-
- powerManagement.enable = false;
-
- time.timeZone = "America/Los_Angeles";
-
- fonts.fonts = with pkgs; [
- google-fonts mononoki source-code-pro fantasque-sans-mono hack-font
- fira fira-code fira-code-symbols
- ];
-
- nixpkgs = {
- config = {
- allowUnfree = true;
- allowBroken = true;
- };
- };
-
- hardware = {
- opengl.enable = true;
- pulseaudio = {
- enable = true;
- extraConfig = ''
- load-module module-loopback
- '';
- };
- };
-
- programs = {
- bash.enableCompletion = true;
- command-not-found.enable = true;
- gnupg.agent = {
- enable = true;
- enableSSHSupport = true;
- };
- mosh.enable = true;
- };
-
- virtualisation = {
- docker = {
- enable = true;
- liveRestore = false;
- };
- libvirtd.enable = true;
- virtualbox = {
- host = {
- enable = false;
- headless = false;
- addNetworkInterface = false;
- };
- guest = {
- enable = false;
- x11 = false;
- };
- };
- };
-
- # https://github.com/NixOS/nixpkgs/issues/53985
- systemd.services.gitlab-runner.path = ["/run/wrappers"];
-
- services = {
- pcscd.enable = true;
- logind = {
- lidSwitch = "ignore";
- extraConfig = "IdleAction=ignore";
- };
-
- # runner for hero ci
- gitlab-runner = {
- packages = [ pkgs.bash pkgs.git pkgs.python3 ];
- enable = true;
- gracefulTimeout = "2min";
- gracefulTermination = true;
- configFile = "/home/ben/gitlab-runner.toml";
- };
-
- openssh = {
- enable = true;
- forwardX11 = true;
- };
-
- deluge = {
- enable = true;
- openFilesLimit = 10240;
- web.enable = true;
- };
-
- printing.enable = true;
-
- xserver = {
- enable = true;
- layout = "us";
- xkbOptions = "caps:ctrl_modifier";
- displayManager.sddm.enable = true;
- desktopManager = {
- kodi.enable = true;
- plasma5.enable = true;
- xterm.enable = true;
- };
- };
-
- jupyter = {
- enable = false;
- port = 3099;
- ip = "*";
- password = "'sha1:4b14a407cabe:fbab8e5400f3f4f3ffbdb00e996190d6a84bf51e'";
- kernels = {
- python3 = let
- env = (pkgs.python3.withPackages (p: with p; [
- ipykernel pandas scikitlearn numpy matplotlib sympy ipywidgets
- ]));
- in {
- displayName = "py3";
- argv = [
- "${env.interpreter}"
- "-m"
- "ipykernel_launcher"
- "-f"
- "{connection_file}"
- ];
- language = "python";
- #logo32 = "${env.sitePackages}/lib/python3.6/site-packages/ipykernel/resources/logo-32x32.png";
- #logo64 = "${env.sitePackages}/lib/python3.6/site-packages/ipykernel/resources/logo-64x64.png";
- };
- };
- };
-
- jellyfin = { # previously emby
- enable = true;
- user = "jellyfin";
- group = "jellyfin";
- };
-
- vnstat.enable = true;
-
- # security stuff
- fail2ban.enable = true;
- clamav = {
- daemon.enable = true;
- updater.enable = true;
- };
-
- postgresql = {
- enable = true;
- package = pkgs.postgresql_10;
- authentication = ''
- local all pprjam md5
- local all pprjam_test md5
- '';
- enableTCPIP = true;
- };
- redis = {
- enable = true;
- };
- };
-
- nix = {
- gc = {
- automatic = true;
- dates = "03:15";
- };
- binaryCaches = [ "https://cache.nixos.org/" ];
- nixPath = [
- "nixpkgs=/nix/var/nix/profiles/per-user/root/channels/nixos/nixpkgs"
- "nixos-config=/etc/nixos/configuration.nix"
- "/nix/var/nix/profiles/per-user/root/channels"
- ];
- extraOptions = ''
- gc-keep-outputs = true
- gc-keep-derivations = true
- '';
- };
-
- # This value determines the NixOS release with which your system is to be
- # compatible, in order to avoid breaking some software such as database
- # servers. You should change this only after NixOS release notes say you
- # should.
- system.stateVersion = "17.09"; # Did you read the comment?
- system.autoUpgrade.enable = true;
-
-}
diff --git a/com/simatime/dev/hardware.nix b/com/simatime/dev/hardware.nix
deleted file mode 100644
index fc0e7a0..0000000
--- a/com/simatime/dev/hardware.nix
+++ /dev/null
@@ -1,34 +0,0 @@
-# Do not modify this file! It was generated by ‘nixos-generate-config’
-# and may be overwritten by future invocations. Please make changes
-# to /etc/nixos/configuration.nix instead.
-{ config, lib, pkgs, ... }:
-
-{
- imports =
- [ <nixpkgs/nixos/modules/installer/scan/not-detected.nix>
- ];
-
- boot.initrd.availableKernelModules = [ "xhci_pci" "ahci" "usbhid" "sd_mod" ];
- boot.kernelModules = [ "kvm-intel" ];
- boot.extraModulePackages = [ ];
-
- fileSystems."/" =
- { device = "/dev/disk/by-uuid/0d8b0e52-10de-4af2-bcd9-b36278352e77";
- fsType = "ext4";
- };
-
- fileSystems."/boot" =
- { device = "/dev/disk/by-uuid/9B89-85C7";
- fsType = "vfat";
- };
-
- fileSystems."/mnt/lake" =
- { device = "/dev/disk/by-uuid/037df3ae-4609-402c-ab1d-4593190d0ee7";
- fsType = "ext4";
- };
-
- swapDevices = [ ];
-
- nix.maxJobs = lib.mkDefault 4;
- powerManagement.cpuFreqGovernor = "powersave";
-}
diff --git a/com/simatime/fathom.nix b/com/simatime/fathom.nix
deleted file mode 100644
index 40e8b0b..0000000
--- a/com/simatime/fathom.nix
+++ /dev/null
@@ -1,109 +0,0 @@
-{ options
-, lib
-, config
-, pkgs
-, modulesPath
-, stdenv
-}:
-
-with lib;
-
-let
- cfg = config.services.fathom
- pkgs.fathom = stdenv.mkDerivation rec {
- name = "fathom-v${version}";
- version = "1.2.1";
- src = builtins.fetchurl {
- url = "https://github.com/usefathom/fathom/releases/download/v${version}/fathom_${version}_linux_amd64.tar.gz";
- sha256 = "0sfpxh2xrvz992k0ynib57zzpcr0ikga60552i14m13wppw836nh";
- };
- sourceRoot = ".";
- dontBuild = true;
- installPhase = ''
- mkdir -p $out/bin
- cp fathom $out/bin
- cp LICENSE $out
- cp README.md $out
- '';
- };
-in {
- options.services.fathom = {
- enable = lib.mkEnableOption "Enable the Fathom Analytics service";
-
- port = mkOption {
- type = types.string;
- default = "3000";
- description = ''
- The port on which Fathom will listen for
- incoming HTTP traffic.
- '';
- };
-
- gzip = mkOption {
- type = types.bool;
- default = true;
- description = "Whether or not to enable gzip compression.";
- };
-
- debug = mkOption {
- type = types.bool;
- default = false;
- description = "Whether or not to enable debug mode.";
- };
-
- dataDir = mkOption {
- type = types.path;
- default = "/var/lib/fathom";
- description = "Fathom data directory";
- };
- };
-
- config = mkIf cfg.enable {
- systemd.services.fathom = {
- wantedBy = [ "multi-user.target" ];
- after = [ "network.target" ];
-
- environment = {
- FATHOM_SERVER_ADDR = cfg.port;
- FATHOM_GZIP = builtins.toString cfg.gzip;
- FATHOM_DEBUG = builtins.toString cfg.debug;
- FATHOM_DATABASE_DRIVER = "sqlite3";
- FATHOM_DATABASE_NAME = "${cfg.dataDir}/fathom.db";
- FATHOM_SECRET = "random-secret-string";
- };
- preStart = ''
- echo "[fathom] creating ${cfg.dataDir}"
- mkdir -p ${cfg.dataDir}
- chown -R fathom:fathom ${cfg.dataDir}
- echo "[fathom]" creating ${cfg.dataDir}/.env
- env | grep "^FATHOM" > ${cfg.dataDir}/.env
- '';
- description = ''
- Fathom Analytics
- '';
-
- serviceConfig = {
- Type = "simple";
- User = "fathom";
- Group = "fathom";
- ExecStart = "${pkgs.fathom}/bin/fathom server";
- KillSignal = "INT";
- WorkingDirectory = cfg.dataDir;
- Restart = "on-failure";
- RestartSec = "10";
- PermissionsStartOnly = "true";
- };
- };
-
- environment.systemPackages = [ pkgs.fathom ];
-
- users = {
- groups = { fathom = {}; };
- users.fathom = {
- description = "Fathom daemon user";
- home = cfg.dataDir;
- group = "fathom";
- };
- };
- };
-}
diff --git a/com/simatime/firefox.nix b/com/simatime/firefox.nix
deleted file mode 100644
index 12316fb..0000000
--- a/com/simatime/firefox.nix
+++ /dev/null
@@ -1,12 +0,0 @@
-{ ... }:
-
-{
- services = {
- firefox.syncserver = {
- enable = true;
- allowNewUsers = true;
- listen.port = 5001;
- publicUri = "http://firefoxsync.simatime.com";
- };
- };
-}
diff --git a/com/simatime/git.nix b/com/simatime/git.nix
deleted file mode 100644
index 51e46b6..0000000
--- a/com/simatime/git.nix
+++ /dev/null
@@ -1,18 +0,0 @@
-{ pkgs, ... }:
-
-{
- services = {
- gitolite = {
- enable = true;
- enableGitAnnex = true;
- # TODO: change this to /var/lib/gitolite?
- dataDir = "/srv/git";
- user = "git";
- group = "git";
- extraGitoliteRc = ''
- $RC{SITE_INFO} = 'a computer is a bicycle for the mind.';
- '';
- adminPubkey = builtins.readFile ./keys/ben.pub;
- };
- };
-}
diff --git a/com/simatime/go.hs b/com/simatime/go.hs
deleted file mode 100644
index 1b32230..0000000
--- a/com/simatime/go.hs
+++ /dev/null
@@ -1,100 +0,0 @@
--- based on
--- https://stackoverflow.com/questions/4522387/how-can-i-emulate-gos-channels-with-haskell
--- but this version encodes end-of-stream on the communication channel, as a Nothing
-
-module Com.Simatime.Go
- ( chan
- , readCh
- , (-<-)
- , writeCh
- , (->-)
- , go
- )
-where
-
-import Control.Concurrent ( forkIO
- , ThreadId
- , threadDelay
- )
-import Control.Concurrent.STM.TChan ( newTChan
- , readTChan
- , writeTChan
- , isEmptyTChan
- , TChan
- )
-import Control.Monad ( forM_ )
-import GHC.Conc ( atomically )
-
--- | Make a new channel.
-chan :: _
-chan = atomically . newTChan
-
--- | Take from a channel.
-readCh :: TChan a -> IO a
-readCh = atomically . readTChan
-
--- | Alias for 'readCh'.
---
--- >>> c <- chan
--- >>> writeCh c "val"
--- >>> -<- c
--- "val"
---
--- I don't think this looks terrible with do-notation:
---
--- >>> c <- chan
--- >>> writeCh c "val"
--- >>> result <- -<- c
--- >>> print result
--- "val"
-(-<-) :: TChan a -> IO a
-(-<-) = readCh
-
--- | Write to a channel.
-writeCh :: TChan a -> a -> IO ()
-writeCh ch v = atomically $ writeTChan ch v
-
--- | Alias for 'writeCh', but flipped to make it read better.
---
--- >>> c <- chan
--- >>> "val" ->- c
--- >>> readCh c
--- "val"
-(->-) :: TChan a -> a -> IO ()
-(->-) = flip writeCh
-
--- | Starts a background process.
-go :: IO () -> IO ThreadId
-go = forkIO
-
-
-{- Example: (TODO: move to module-level docs)
-
--- can I just implement forM/Traversable over the channel?
-forRange :: TChan (Maybe a) -> (a -> IO b) -> IO [b]
-forRange ch fn = helper fn [] where
- -- helper :: (a -> IO b) -> [b] -> IO [b]
- helper fn acc = do
- jv <- readCh ch
- case jv of
- Nothing -> return $ reverse acc
- Just v -> do
- b <- fn v
- helper fn (b : acc)
-
-feedData :: (Num a, Enum a) => TChan (Maybe a) -> IO ()
-feedData ch = do
- forM_ [1 .. 9999] (\x -> writeCh ch (Just x))
- writeQ ch Nothing -- EOF value
-
-printData :: TChan (Maybe Int) -> IO ()
-printData c = do
- forRange c (print :: Int -> IO ())
- return ()
-
-main :: IO ()
-main = do
- ch <- chan
- go $ feedData ch
- printData ch
--}
diff --git a/com/simatime/hardware.nix b/com/simatime/hardware.nix
deleted file mode 100644
index 8c88cb7..0000000
--- a/com/simatime/hardware.nix
+++ /dev/null
@@ -1,6 +0,0 @@
-{ ... }:
-{
- imports = [ <nixpkgs/nixos/modules/profiles/qemu-guest.nix> ];
- boot.loader.grub.device = "/dev/vda";
- fileSystems."/" = { device = "/dev/vda1"; fsType = "ext4"; };
-}
diff --git a/com/simatime/idea/duree-pitch.org b/com/simatime/idea/duree-pitch.org
deleted file mode 100644
index d4d9d6f..0000000
--- a/com/simatime/idea/duree-pitch.org
+++ /dev/null
@@ -1,80 +0,0 @@
-#+TITLE: Duree: automated universal database
-#+SUBTITLE: seeking pre-seed funding
-#+AUTHOR: Ben Sima <ben@bsima.me>
-#+EMAIL: ben@bsima.me
-#+OPTIONS: H:1 num:nil toc:nil
-#+LATEX_CLASS: article
-#+LATEX_CLASS_OPTIONS:
-#+LATEX_HEADER:
-#+LATEX_HEADER_EXTRA:
-#+LATEX_COMPILER: pdflatex
-#+DATE: \today
-#+startup: beamer
-#+LaTeX_CLASS: beamer
-#+LaTeX_CLASS_OPTIONS: [presentation,smaller]
-Start with this:
- - https://news.ycombinator.com/item?id=14605
- - https://news.ycombinator.com/item?id=14754
-Then build AI layers on top.
-* Problem
-Developers spend too much time managing database schemas. Every database
-migration is a risk to the business because of the high possibility of data
-corruption. If the data is modeled incorrectly at the beginning, it requires a
-lot of work (months of developer time) to gut the system and re-architect it.
-* Solution
-- Using machine learning and AI, we automatically detect the schema of your data.
-- Data can be dumped into a noSQL database withouth the developer thinking much
- about structure, then we infer the structure automatically.
-- We can also generate a library of queries and provide an auto-generated client
- in the choosen language of our users.
-* Existing solutions
-- Libraries like alembic and migra (Python) make data migrations easier, but
- don't help you make queries or properly model data.
-- ORMs help with queries but don't give you much insight into the deep structure
- of your data (you still have to do manual joins) and don't help you properly
- model data.
-- Graph QL is the closest competitor, but requires manually writing types and
- knowing about the deep structure of your data. We automate both.
-
-* Unsolved problems
-- Unsure whether to build this on top of existing noSQL databases, or to develop
- our own data store. Could re-use an existing [[https://en.wikipedia.org/wiki/Category:Database_engines][database engine]] to provide an
- end-to-end database solution.
-* Key metrics
-- How much time do developers spend dealing with database migrations? What does
- this cost the business? We can decrease this, decreasing costs.
-- How costly are failed data migrations and backups? We reduce this risk.
-* Unique value proposition
-We can automate the backend data mangling for 90% of software applications.
-* Unfair advantage
-- I have domain expertise, having worked on similar schemaless database problems
- before.
-- First-mover advantage in this space. Everyone else is focused on making
- database migrations easier, we want to make them obsolete.
-* Channels
-- Cold calling mongoDB et al users.
-* Customer segments
-- *Early adopters:* users of mongoDB and graphQL who want to spend time writing
- application code, not managing database schemas. The MVP would be to generate
- the Graph QL code from their Mongo database automatically.
-- Will expand support to other databases one by one. The tech could be used on
- any database... or we expand by offering our own data store.
-* Cost structure
-** Fixed costs
- - Initial development will take about 3 months (~$30k)
- - Each new database support will take a month or two of development.
-** Variable costs
- - Initial analysis will be compute-heavy.
- - Following analyses can be computationally cheap by buildiing off of the
- existing model.
- - Customer acquisition could be expensive, will likely hire a small sales
- team.
-* Revenue streams
-- $100 per month per database analyzed
- - our hosted service connects to their database directly
- - includes client libraries via graphQL
- - may increase this if it turns out we save companies a lot more than $100/mo,
- which is likely
-- enterprise licenses available for on-prem
- - allows them to have complete control over their database access
- - necessary for HIPAA/PCI compliance
diff --git a/com/simatime/idea/flash.org b/com/simatime/idea/flash.org
deleted file mode 100644
index 1c392f0..0000000
--- a/com/simatime/idea/flash.org
+++ /dev/null
@@ -1,36 +0,0 @@
-#+title: Flash
-#+description: a system for quickly testing business ideas
-
-- Each marketing iteration for a product requires some gear. A "gear" pack is just a yaml
- file with all data for a single flash test. It will include ad content,
- pricing info, links to necessary images, and so on.
- - even better: store these in a database? Depends on how often we need to edit them...
-- Data gets marshalled into a bunch of templates, one for each sales pipeline in
- the /Traction/ book by Gabriel Weinberg (7 pipelines total)
-- Each sales pipeline will have a number of integrations, we'll need at least
- one for each pipeline before going to production. E.g.:
- - google adwords
- - facebook ads
- - email lists (sendgrid)
- - simple marketing website
- - producthunt
- - etc
-- Pipelines will need to capture metrics on a pre-set schedule.
- - Above integrations must also pull performance numbers from Adwords etc APIs.
- - Will need some kind of scheduled job queue or robot background worker to handle this.
- - A simple dashboard might also be useful, not sure.
-- Metrics determine the performance of a pipeline. After the defined trial
- duration, some pipelines will be dropped. The high-performing pipelines we
- double-down on.
-- Metrics to watch:
- - conversion rate
- - usage time - minutes spent on site/app
- - money spent per customer
- - see baremetrics for more ideas
-- This can eventually be integrated to a larger product design platform (what Sam
- Altman calls a "product improvement engine" in his playbook - PIE?).
- - metric improvement can be plotted on a relative scale
- - "If you improve your product 5% every week, it will really compound." - Sam
- - PIE will differ from Flash in that Flash is only for the early stages of a
- product - sell it before you build it. PIE will operate on existing products
- to make them better.
diff --git a/com/simatime/keys/ben.pub b/com/simatime/keys/ben.pub
deleted file mode 100644
index c661508..0000000
--- a/com/simatime/keys/ben.pub
+++ /dev/null
@@ -1 +0,0 @@
-ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDDhmSEbvX6LSk1ZO/whhAWpxwUxGPwbn7ZKVmxLcIilLdkd/vhFQKSYyMBW+21G3cMbwyFVsCyPbADoXcvV5OSIklxgitP77/2TAgkEPjyklJ4KD0QNDjpu+YGGIyVTgE9YPBhpwuUlxRhux15vN8xzAXq4f5/xpyBPekIdbEaEUZHrKN/z9g8cgw9ZMWSrchbsE3QlU8MJK78HO+v3TjH7Ip+LffWNuhckiYnzT8Duy47vgc1OYqtJaDMN/ufK7yeNILK81M1ybHGOlqYxSfV/RM7oD0P5w5YeTXMpRsOyn4YVzhWSQFrlf08XbwlZUNm6Pb8eNRjM+3YyFTcUU/S81xKwOPRNNhlPnxz+tUltCR3H/0Falu1pxJYT2qfuM9j9z9xA1bJEsSSZ1b2bsHw7ujpRmg0xsPUk7DXIQ1Kh92BFfmDoZWeqsMF1E7H8iuaVsN9k96BwbBfiB4stQqI3ycuHO9zbsa12y8AQusDbr9W8rl/vR0pKNrcNO32ojOzkblJGWgyNxDvTS4l69+qi6pMBONicUUMQnXEtJoasjpECzwlAHIYJMmFQUuloEafR8b0ZAaCw+I5SfsyYF4hHLYseHvMavxgLNZ6W4ZlaL9XmQ7ZGhh10ub4ceW61QvCzKD34yO1yl8PcmS8Fa7bZbGxkq36oCusGbD65AlY+w== ben@lithium
diff --git a/com/simatime/keys/deploy.pub b/com/simatime/keys/deploy.pub
deleted file mode 100644
index 664a2d9..0000000
--- a/com/simatime/keys/deploy.pub
+++ /dev/null
@@ -1 +0,0 @@
-ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDlLRbbXgwjF7IqObf4dZE/jj0HoT6xJR6bP/6ZrJz7NPCPIgY3GacOtBfkJp6KK0zKQdFmxNpcfb3zgpe/Ru7pkmSfI9IoWAU3aLPWK2G3tbLPmktGmF9C53OhyXgFtBGr2Q/+wSRKAfN/FrEEa2FuRBtvtcAMiwbQLbFCzlmWhE7swSBvg38ZSFrjhANsEhfNVCtsrtG16fkfrfmBFv4JIog1fEoMKmXg7rhMjpaas8+n52HMFXvjllePRpywK4wB20GOcOuDSdc3i3zs7NFuicGunEpW2S/byrHotSWHZ9VuUwPn3GJ6xorrGyvsRuPS2anhHTSBxYCqYdXg0BIYUn1x5Uhtzd8kIU06gSLsvuhqGCLNucnXAT1Zix7pSlO21be81SX4vwQEth+6Dkm6kja0ArHZL6wglF8Njd1fV9iOwvcS07clwa/2S8suFLwVrQXz16vfAfA2zi4/qeop5Sv9W4DIOZuIMPmbWZCoy7L6Fu4+x4prb8LCQNM5m4CP3HngCW8PpxtBbBJd0dcXVap1HgDTIt/CLH8ms52uX5k3bHuvzryOihSuwmi/cDZAJAmbgclM9klsZr4R/GAoAWhhGxXM2tLuiwZ2nLvCPlXbBazZpdM2aC3VIwnMwJrJFu2u9B6RSsz2ijbygecT98UmiMYK7Mk1y6GkvY+mDQ== ben@lithium
diff --git a/com/simatime/keys/nick.pub b/com/simatime/keys/nick.pub
deleted file mode 100644
index 4dc08fb..0000000
--- a/com/simatime/keys/nick.pub
+++ /dev/null
@@ -1 +0,0 @@
-ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDfSOxXJTQADjROqbaiJtjbJaHTsBtuWNvQpDvXLigl9R27VqIn7dYk2STuWglwFyrvYfU1UmjgJcJ6J2KbXGTH5mhaC04MJ4aqmOR3Ynnq7nDzmtEtn1I+K7LmpFXsFXgOTzIlzggIWflGd1pPBwgWqMoPDcSqNQFPI/+rk1JOxk3e2Mq60VTp9WM9hs0AJQEyZ+wwZ0vyrj588kQb6jQUZ7qx1UZoDzPc57zREEZbQeU1Gd9FK2bCHlKOBHYlqIftSRBGGCpuo7zobhajR0xHO9RnF0NmeLbW85XhDus8vVgBg/BTDPxHEzm5jKiCkc+i3ia0Ff9mp2zgtSdXCp5jbVZ3AYfYLi1zbPWmaSdWqFx2ntOLwWR3/RHjw6+b4KmUQ4xtQHyXOijTBCH29i7VCo7l8WL+I2mSGJ7/Wtw7NFtMpVVs8/0iKt2t12FIefzvbZoWU7vbmuO7+gQI5l+F+JE6DLWOl04vT/V98WxiHA5rbCjTT/bubs4gTeCR9qNehaoM+apitpUP8HXygnxD7EJeK6JNkdub9TY663IkiKlpnWgeoDTNSP7JF/jkU0Nt8yoR2pTyxQqMFYa37/3WKjmSHk1TgxLEmlwHQFtIkTPn8PL+VLa4ACYuWUjxS4aMRpxo9eJUHdy0Y04yKxXN8BLw7FAhytm2pTXtT4zqaQ== nicksima@gmail.com
diff --git a/com/simatime/language/bs.hs b/com/simatime/language/bs.hs
deleted file mode 100644
index a810706..0000000
--- a/com/simatime/language/bs.hs
+++ /dev/null
@@ -1,12 +0,0 @@
--- https://github.com/write-you-a-scheme-v2/scheme
--- https://github.com/justinethier/husk-scheme
-module Language.Bs
- ( module X
- ) where
-
-import Language.Bs.Cli as X
-import Language.Bs.Eval as X
-import Language.Bs.Expr as X
-import Language.Bs.Parser as X
-import Language.Bs.Primitives as X
-import Language.Bs.Repl as X
diff --git a/com/simatime/language/bs/cli.hs b/com/simatime/language/bs/cli.hs
deleted file mode 100644
index 4c48c86..0000000
--- a/com/simatime/language/bs/cli.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Bs.Cli (
- run
-) where
-
-import Data.String
-import Data.Text.IO as TIO
-import Language.Bs.Eval -- evalFile :: T.Text -> IO ()
-import Language.Bs.Repl -- Repl.mainLoop :: IO ()
-import Options.Applicative
-import Protolude
-import System.Directory
-
--- SOURCES
---http://book.realworldhaskell.org/read/io.html
--- https://github.com/pcapriotti/optparse-applicative
--- https://hackage.haskell.org/package/optparse-applicative
-
-runScript :: FilePath -> IO ()
-runScript fname = do
- exists <- doesFileExist fname
- if exists
- then TIO.readFile fname >>= evalFile fname
- else TIO.putStrLn "File does not exist."
-
-data LineOpts = UseReplLineOpts | RunScriptLineOpts String
-
-parseLineOpts :: Parser LineOpts
-parseLineOpts = runScriptOpt <|> runReplOpt
- where
- runScriptOpt =
- RunScriptLineOpts <$> strOption (long "script"
- <> short 's'
- <> metavar "SCRIPT"
- <> help "File containing the script you want to run")
- runReplOpt =
- UseReplLineOpts <$ flag' () (long "repl"
- <> short 'r'
- <> help "Run as interavtive read/evaluate/print/loop")
-
-schemeEntryPoint :: LineOpts -> IO ()
-schemeEntryPoint UseReplLineOpts = mainLoop --repl
-schemeEntryPoint (RunScriptLineOpts script) = runScript script
-
-run :: IO ()
-run = execParser opts >>= schemeEntryPoint
- where
- opts = info (helper <*> parseLineOpts)
- ( fullDesc
- <> header "Executable binary for Write You A Scheme v2.0"
- <> progDesc "contains an entry point for both running scripts and repl" )
diff --git a/com/simatime/language/bs/eval.hs b/com/simatime/language/bs/eval.hs
deleted file mode 100644
index 290170b..0000000
--- a/com/simatime/language/bs/eval.hs
+++ /dev/null
@@ -1,241 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Bs.Eval (
- evalText
-, evalFile
-, runParseTest
-, safeExec
-, runASTinEnv
-, basicEnv
-, fileToEvalForm
-, textToEvalForm
-, getFileContents
-) where
-
-import Control.Exception
-import Control.Monad.Reader
-import qualified Data.Map as Map
-import Data.String
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import Language.Bs.Expr
-import Language.Bs.Parser
-import Language.Bs.Primitives
-import Protolude
-import System.Directory
-
-funcEnv :: Map.Map T.Text Expr
-funcEnv = Map.fromList $ primEnv
- <> [ ("read" , IFun $ IFunc $ unop readFn)
- , ("parse", IFun $ IFunc $ unop parseFn)
- , ("eval", IFun $ IFunc $ unop eval)
- , ("show", IFun $ IFunc $ unop (return . Tape . ppexpr))
- ]
-
-basicEnv :: Env
-basicEnv = Env Map.empty funcEnv
-
-readFn :: Expr -> Eval Expr
-readFn (Tape txt) = lineToEvalForm txt
-readFn val = throw $ TypeMismatch "read expects string, instead got:" val
-
-parseFn :: Expr -> Eval Expr
-parseFn (Tape txt) = either (throw . ParseError . show) return $ readExpr txt
-parseFn val = throw $ TypeMismatch "parse expects string, instead got:" val
-
-safeExec :: IO a -> IO (Either String a)
-safeExec m = do
- result <- Control.Exception.try m
- case result of
- Left (eTop :: SomeException) ->
- case fromException eTop of
- Just (enclosed :: LispError) ->
- return $ Left (show enclosed)
- Nothing ->
- return $ Left (show eTop)
- Right val ->
- return $ Right val
-
-runASTinEnv :: Env -> Eval b -> IO b
-runASTinEnv code action = runReaderT (unEval action) code
-
-lineToEvalForm :: T.Text -> Eval Expr
-lineToEvalForm input = either (throw . ParseError . show ) eval $ readExpr input
-
-evalFile :: FilePath -> T.Text -> IO () -- program file
-evalFile filePath fileExpr = (runASTinEnv basicEnv $ fileToEvalForm filePath fileExpr) >>= print
-
-fileToEvalForm :: FilePath -> T.Text -> Eval Expr
-fileToEvalForm filePath input = either (throw . ParseError . show ) evalBody $ readExprFile filePath input
-
-runParseTest :: T.Text -> T.Text -- for view AST
-runParseTest input = either (T.pack . show) (T.pack . show) $ readExpr input
-
-getFileContents :: FilePath -> IO T.Text
-getFileContents fname = do
- exists <- doesFileExist fname
- if exists then TIO.readFile fname else return "File does not exist."
-
-textToEvalForm :: T.Text -> Eval Expr
-textToEvalForm input = either (throw . ParseError . show ) evalBody $ readExpr input
-
-evalText :: T.Text -> IO () --REPL
-evalText textExpr = do
- res <- runASTinEnv basicEnv $ textToEvalForm textExpr
- print res
-
-getVar :: Expr -> Eval Expr
-getVar (Atom atom) = do
- Env{..} <- ask
- case Map.lookup atom (Map.union fenv env) of -- lookup, but prefer functions
- Just x -> return x
- Nothing -> throw $ UnboundVar atom
-getVar n = throw $ TypeMismatch "failure to get variable: " n
-
-ensureAtom :: Expr -> Eval Expr
-ensureAtom n@(Atom _) = return n
-ensureAtom n@(List _) = throw $ TypeMismatch "got list" n
-ensureAtom n = throw $ TypeMismatch "expected an atomic value" n
-
-extractVar :: Expr -> T.Text
-extractVar (Atom atom) = atom
-extractVar n = throw $ TypeMismatch "expected an atomic value" n
-
-getEven :: [t] -> [t]
-getEven [] = []
-getEven (x:xs) = x : getOdd xs
-
-getOdd :: [t] -> [t]
-getOdd [] = []
-getOdd (_:xs) = getEven xs
-
-applyFunc :: Expr -> [Expr] -> [Expr] -> Eval Expr
-applyFunc expr params args = bindArgsEval params args expr
-
-bindArgsEval :: [Expr] -> [Expr] -> Expr -> Eval Expr
-bindArgsEval params args expr = do
- Env{..} <- ask
- let newVars = zipWith (\a b -> (extractVar a,b)) params args
- let (newEnv, newFenv) = Map.partition (not . isFunc) $ Map.fromList newVars
- local (const $ Env (newEnv <> env) (newFenv <> fenv)) $ eval expr
-
-isFunc :: Expr -> Bool
-isFunc (List ((Atom "lambda"):_)) = True
-isFunc _ = False
-
-eval :: Expr -> Eval Expr
-eval (List [Atom "dumpEnv", x]) = do
- Env{..} <- ask
- liftIO $ print $ toList env
- liftIO $ print $ toList fenv
- eval x
-
-eval (Numb i) = return $ Numb i
-eval (Tape s) = return $ Tape s
-eval (Bool b) = return $ Bool b
-eval (List []) = return Nil
-eval Nil = return Nil
-eval n@(Atom _) = getVar n
-
-eval (List [Atom "showSF", rest]) = return . Tape . T.pack $ show rest
-eval (List ((:) (Atom "showSF") rest)) = return . Tape . T.pack . show $ List rest
-
-eval (List [Atom "quote", val]) = return val
-
-eval (List [Atom "if", pred_, then_, else_]) = do
- ifRes <- eval pred_
- case ifRes of
- (Bool True) -> eval then_
- (Bool False) -> eval else_
- _ ->
- throw $ BadSpecialForm "if's first arg must eval into a boolean"
-eval (List ( (:) (Atom "if") _)) =
- throw $ BadSpecialForm "(if <bool> <s-expr> <s-expr>)"
-
-eval (List [Atom "begin", rest]) = evalBody rest
-eval (List ((:) (Atom "begin") rest )) = evalBody $ List rest
-
--- top-level define
--- TODO: how to make this eval correctly?
-eval (List [Atom "define", List (name:args), body]) = do
- Env{..} <- ask
- _ <- eval body
- bindArgsEval (name:args) [body] name
-
-eval (List [Atom "define", name, body]) = do
- Env{..} <- ask
- _ <- eval body
- bindArgsEval [name] [body] name
-
-eval (List [Atom "let", List pairs, expr]) = do
- Env{..} <- ask
- atoms <- mapM ensureAtom $ getEven pairs
- vals <- mapM eval $ getOdd pairs
- bindArgsEval atoms vals expr
-
-eval (List (Atom "let":_) ) =
- throw $ BadSpecialForm "let function expects list of parameters and S-Expression body\n(let <pairs> <s-expr>)"
-
-
-eval (List [Atom "lambda", List params, expr]) = do
- ctx <- ask
- return $ Func (IFunc $ applyFunc expr params) ctx
-eval (List (Atom "lambda":_) ) = throw $ BadSpecialForm "lambda function expects list of parameters and S-Expression body\n(lambda <params> <s-expr>)"
-
-
--- needed to get cadr, etc to work
-eval (List [Atom "cdr", List [Atom "quote", List (_:xs)]]) =
- return $ List xs
-eval (List [Atom "cdr", arg@(List (x:xs))]) =
- case x of
- -- proxy for if the list can be evaluated
- Atom _ -> do
- val <- eval arg
- eval $ List [Atom "cdr", val]
- _ -> return $ List xs
-
-
-eval (List [Atom "car", List [Atom "quote", List (x:_)]]) =
- return $ x
-eval (List [Atom "car", arg@(List (x:_))]) =
- case x of
- Atom _ -> do
- val <- eval arg
- eval $ List [Atom "car", val]
- _ -> return $ x
-
-
-eval (List ((:) x xs)) = do
- Env{..} <- ask
- funVar <- eval x
- xVal <- mapM eval xs
- case funVar of
- (IFun (IFunc internalFn)) ->
- internalFn xVal
-
- (Func (IFunc definedFn) (Env benv _)) ->
- local (const $ Env benv fenv) $ definedFn xVal
-
- _ ->
- throw $ NotFunction funVar
-
-updateEnv :: T.Text -> Expr -> Env -> Env
-updateEnv var e@(IFun _) Env{..} = Env env $ Map.insert var e fenv
-updateEnv var e@(Func _ _) Env{..} = Env env $ Map.insert var e fenv
-updateEnv var e Env{..} = Env (Map.insert var e env) fenv
-
-evalBody :: Expr -> Eval Expr
-evalBody (List [List ((:) (Atom "define") [Atom var, defExpr]), rest]) = do
- evalVal <- eval defExpr
- ctx <- ask
- local (const $ updateEnv var evalVal ctx) $ eval rest
-
-evalBody (List ((:) (List ((:) (Atom "define") [Atom var, defExpr])) rest)) = do
- evalVal <- eval defExpr
- ctx <- ask
- local (const $ updateEnv var evalVal ctx) $ evalBody $ List rest
-
-evalBody x = eval x
diff --git a/com/simatime/language/bs/expr.hs b/com/simatime/language/bs/expr.hs
deleted file mode 100644
index a39c7b6..0000000
--- a/com/simatime/language/bs/expr.hs
+++ /dev/null
@@ -1,154 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Language.Bs.Expr where
-
-import Data.String (String)
-import Data.Text (Text)
-import qualified Data.Text as T
-import GHC.Show
-import Protolude hiding (show)
-import qualified Text.PrettyPrint.Leijen.Text as PP
-import Text.PrettyPrint.Leijen.Text hiding ((<$>))
-
-type Ctx = Map Text Expr
-data Env = Env { env :: Ctx, fenv :: Ctx }
- deriving (Eq)
-
-newtype Eval a = Eval { unEval :: ReaderT Env IO a }
- deriving (Monad, Functor, Applicative, MonadReader Env, MonadIO)
-
-data IFunc = IFunc { fn :: [Expr] -> Eval Expr }
- deriving (Typeable)
-
-instance Eq IFunc where
- (==) _ _ = False
-
-data Expr
- = Atom Text
- | List [Expr]
- | Numb Integer
- | Tape Text
- | IFun IFunc -- TODO: call this Kern
- | Func IFunc Env
- | Bool Bool
- | Nil
- deriving (Typeable, Eq)
-
-instance Show Expr where
- show = T.unpack . ppexpr
-
-data LispErrorType
- = NumArgs Integer [Expr]
- | LengthOfList Text Int
- | ExpectedList Text
- | ParseError String
- | TypeMismatch Text Expr
- | BadSpecialForm Text
- | NotFunction Expr
- | UnboundVar Text
- | Default Expr
- | ReadFileError Text
- deriving (Typeable)
-
-data LispError = LispError Expr LispErrorType
-
-instance Show LispErrorType where
- show = T.unpack . ppexpr
-
-instance Show LispError where
- show = T.unpack . ppexpr
-
-instance Exception LispErrorType
-instance Exception LispError
-
-ppexpr :: Pretty a => a -> Text
-ppexpr x = PP.displayTStrict (PP.renderPretty 1.0 70 (pretty x))
-
---prettyList :: [Doc] -> Doc
---prettyList = encloseSep lparen rparen PP.space
-
-instance Pretty Expr where
- pretty v =
- case v of
- Atom a ->
- textStrict a
-
- List ls ->
- prettyList $ fmap pretty ls
-
- Numb n ->
- integer n
-
- Tape t ->
- textStrict "\"" <> textStrict t <> textStrict "\""
-
- IFun _ ->
- textStrict "<internal function>"
-
- Func _ _ ->
- textStrict "<lambda function>"
-
- Bool True ->
- textStrict "#t"
-
- Bool False ->
- textStrict "#f"
-
- Nil ->
- textStrict "'()"
-
-instance Pretty LispErrorType where
- pretty err = case err of
- NumArgs i args ->
- textStrict "number of arguments"
- <$$> textStrict "expected"
- <+> textStrict (T.pack $ show i)
- <$$> textStrict "received"
- <+> textStrict (T.pack $ show $ length args)
-
-
- LengthOfList txt i ->
- textStrict "length of list in:"
- <+> textStrict txt
- <$$> textStrict "length:"
- <+> textStrict (T.pack $ show i)
-
- ParseError txt ->
- textStrict "cannot parse expr:"
- <+> textStrict (T.pack txt)
-
- TypeMismatch txt expr ->
- textStrict "type mismatch:"
- <$$> textStrict txt
- <$$> pretty expr
-
- BadSpecialForm txt ->
- textStrict "bad special form:"
- <$$> textStrict txt
-
- NotFunction expr ->
- textStrict "not a function"
- <$$> pretty expr
-
- UnboundVar txt ->
- textStrict "unbound variable:"
- <$$> textStrict txt
-
- Default _ ->
- textStrict "default error"
-
- ReadFileError txt ->
- textStrict "error reading file:"
- <$$> textStrict txt
-
- ExpectedList txt ->
- textStrict "expected list:"
- <$$> textStrict txt
-
-instance Pretty LispError where
- pretty (LispError expr typ) =
- textStrict "error evaluating:"
- <$$> indent 4 (pretty expr)
- <$$> pretty typ
diff --git a/com/simatime/language/bs/parser.hs b/com/simatime/language/bs/parser.hs
deleted file mode 100644
index 3044a60..0000000
--- a/com/simatime/language/bs/parser.hs
+++ /dev/null
@@ -1,121 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Bs.Parser (
- readExpr
-, readExprFile
-) where
-
-import Control.Monad (fail)
-import Control.Monad (mzero)
-import Data.Char (digitToInt)
-import Data.Functor.Identity (Identity)
-import Data.String
-import qualified Data.Text as T
-import Language.Bs.Expr
-import Protolude hiding ((<|>), try)
-import Text.Parsec
-import qualified Text.Parsec.Language as Lang
-import Text.Parsec.Text
-import qualified Text.Parsec.Token as Tok
-
-lexer :: Tok.GenTokenParser T.Text () Identity
-lexer = Tok.makeTokenParser style
-
-style :: Tok.GenLanguageDef T.Text () Identity
-style = Lang.emptyDef {
- Tok.commentStart = "#|"
- , Tok.commentEnd = "|#"
- , Tok.commentLine = ";"
- , Tok.opStart = mzero
- , Tok.opLetter = mzero
- , Tok.identStart = letter <|> oneOf "!$%&*/:<=>?^_~"
- , Tok.identLetter = digit <|> letter <|> oneOf "!$%&*/:<=>?^_~+-.@"
- }
-
-parens :: Parser a -> Parser a
-parens = Tok.parens lexer
-
-whitespace :: Parser ()
-whitespace = Tok.whiteSpace lexer
-
-lexeme :: Parser a -> Parser a
-lexeme = Tok.lexeme lexer
-
-quoted :: Parser a -> Parser a
-quoted p = try (char '\'') *> p
-
-identifier :: Parser T.Text
-identifier = T.pack <$> (Tok.identifier lexer <|> specialIdentifier) <?> "identifier"
- where
- specialIdentifier :: Parser String
- specialIdentifier = lexeme $ try $
- string "-" <|> string "+" <|> string "..."
-
--- | The @Radix@ type consists of a base integer (e.g. @10@) and a parser for
--- digits in that base (e.g. @digit@).
-type Radix = (Integer, Parser Char)
-
--- | Parse an integer, given a radix as output by @radix@.
--- Copied from Text.Parsec.Token
-numberWithRadix :: Radix -> Parser Integer
-numberWithRadix (base, baseDigit) = do
- digits <- many1 baseDigit
- let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits
- seq n (return n)
-
-decimal :: Parser Integer
-decimal = Tok.decimal lexer
-
--- | Parse a sign, return either @id@ or @negate@ based on the sign parsed.
--- Copied from Text.Parsec.Token
-sign :: Parser (Integer -> Integer)
-sign = char '-' *> return negate
- <|> char '+' *> return identity
- <|> return identity
-
-intRadix :: Radix -> Parser Integer
-intRadix r = sign <*> numberWithRadix r
-
-textLiteral :: Parser T.Text
-textLiteral = T.pack <$> Tok.stringLiteral lexer
-
-nil :: Parser ()
-nil = try ((char '\'') *> string "()") *> return () <?> "nil"
-
-hashVal :: Parser Expr
-hashVal = lexeme $ char '#'
- *> (char 't' *> return (Bool True)
- <|> char 'f' *> return (Bool False)
- <|> char 'b' *> (Numb <$> intRadix (2, oneOf "01"))
- <|> char 'o' *> (Numb <$> intRadix (8, octDigit))
- <|> char 'd' *> (Numb <$> intRadix (10, digit))
- <|> char 'x' *> (Numb <$> intRadix (16, hexDigit))
- <|> oneOf "ei" *> fail "Unsupported: exactness"
- <|> char '(' *> fail "Unsupported: vector"
- <|> char '\\' *> fail "Unsupported: char")
-
-
-lispVal :: Parser Expr
-lispVal = hashVal
- <|> Nil <$ nil
- <|> Numb <$> try (sign <*> decimal)
- <|> Atom <$> identifier
- <|> Tape <$> textLiteral
- <|> _Quote <$> quoted lispVal
- <|> List <$> parens manyExpr
-
-manyExpr :: Parser [Expr]
-manyExpr = lispVal `sepBy` whitespace
-
-_Quote :: Expr -> Expr
-_Quote x = List [Atom "quote", x]
-
-contents :: Parser a -> ParsecT T.Text () Identity a
-contents p = whitespace *> lexeme p <* eof
-
-readExpr :: T.Text -> Either ParseError Expr
-readExpr = parse (contents lispVal) "<stdin>"
-
-readExprFile :: SourceName -> T.Text -> Either ParseError Expr
-readExprFile = parse (contents (List <$> manyExpr))
diff --git a/com/simatime/language/bs/primitives.hs b/com/simatime/language/bs/primitives.hs
deleted file mode 100644
index c074c59..0000000
--- a/com/simatime/language/bs/primitives.hs
+++ /dev/null
@@ -1,183 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
--- | bs primitives
---
--- I would like to reduce the number of primitives in the language to some
--- minimal number, like SKI combinator or Nock instructions. I'm not sure what
--- the minimal number is. The idea is to move primitives from here into core.scm
--- over time.
-module Language.Bs.Primitives where
-
-import Control.Exception
-import Control.Monad.Except
-import Data.Text as T
-import Data.Text.IO as TIO
-import Language.Bs.Expr
-import Network.HTTP
-import Protolude
-import System.Directory
-import System.IO
-
-type Prim = [(T.Text, Expr)]
-type Unary = Expr -> Eval Expr
-type Binary = Expr -> Expr -> Eval Expr
-
-mkF :: ([Expr] -> Eval Expr) -> Expr
-mkF = IFun . IFunc
-
-primEnv :: Prim
-primEnv = [
- ("+" , mkF $ binopFold (numOp (+)) (Numb 0) )
- , ("*" , mkF $ binopFold (numOp (*)) (Numb 1) )
- , ("string-append", mkF $ binopFold (strOp (<>)) (Tape "") )
- , ("-" , mkF $ binop $ numOp (-))
- , ("<" , mkF $ binop $ numCmp (<))
- , ("<=" , mkF $ binop $ numCmp (<=))
- , (">" , mkF $ binop $ numCmp (>))
- , (">=" , mkF $ binop $ numCmp (>=))
- , ("==" , mkF $ binop $ numCmp (==))
- , ("even?" , mkF $ unop $ numBool even)
- , ("odd?" , mkF $ unop $ numBool odd)
- , ("neg?" , mkF $ unop $ numBool (< 0))
- , ("pos?" , mkF $ unop $ numBool (> 0))
- , ("eq?" , mkF $ binop eqCmd )
- , ("null?" , mkF $ unop (eqCmd Nil) )
- , ("bl-eq?" , mkF $ binop $ eqOp (==))
- , ("and" , mkF $ binopFold (eqOp (&&)) (Bool True))
- , ("or" , mkF $ binopFold (eqOp (||)) (Bool False))
- , ("not" , mkF $ unop $ notOp)
- , ("cons" , mkF $ Language.Bs.Primitives.cons)
- , ("cdr" , mkF $ Language.Bs.Primitives.cdr)
- , ("car" , mkF $ Language.Bs.Primitives.car)
- , ("quote" , mkF $ quote)
- , ("file?" , mkF $ unop fileExists)
- , ("slurp" , mkF $ unop slurp)
- , ("wslurp" , mkF $ unop wSlurp)
- , ("put" , mkF $ binop put_)
- ]
-
-unop :: Unary -> [Expr] -> Eval Expr
-unop op [x] = op x
-unop _ args = throw $ NumArgs 1 args
-
-binop :: Binary -> [Expr] -> Eval Expr
-binop op [x,y] = op x y
-binop _ args = throw $ NumArgs 2 args
-
-fileExists :: Expr -> Eval Expr
-fileExists (Tape txt) = Bool <$> liftIO (doesFileExist $ T.unpack txt)
-fileExists val = throw $ TypeMismatch "read expects string, instead got: " val
-
-slurp :: Expr -> Eval Expr
-slurp (Tape txt) = liftIO $ wFileSlurp txt
-slurp val = throw $ TypeMismatch "read expects string, instead got: " val
-
-wFileSlurp :: T.Text -> IO Expr
-wFileSlurp fileName = withFile (T.unpack fileName) ReadMode go
- where go = readTextFile fileName
-
-openURL :: T.Text -> IO Expr
-openURL x = do
- req <- simpleHTTP (getRequest $ T.unpack x)
- body <- getResponseBody req
- return $ Tape $ T.pack body
-
-wSlurp :: Expr -> Eval Expr
-wSlurp (Tape txt) = liftIO $ openURL txt
-wSlurp val = throw $ TypeMismatch "wSlurp expects a string, instead got: " val
-
-readTextFile :: T.Text -> Handle -> IO Expr
-readTextFile fileName h = do
- exists <- doesFileExist $ T.unpack fileName
- if exists
- then (TIO.hGetContents h) >>= (return . Tape)
- else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName]
-
-put_ :: Expr -> Expr -> Eval Expr
-put_ (Tape file) (Tape msg) = liftIO $ wFilePut file msg
-put_ (Tape _) val = throw $ TypeMismatch "put expects string in the second argument (try using show), instead got: " val
-put_ val _ = throw $ TypeMismatch "put expects string, instead got: " val
-
-wFilePut :: T.Text -> T.Text -> IO Expr
-wFilePut fileName msg = withFile (T.unpack fileName) WriteMode go
- where go = putTextFile fileName msg
-
-putTextFile :: T.Text -> T.Text -> Handle -> IO Expr
-putTextFile fileName msg h = do
- canWrite <- hIsWritable h
- if canWrite
- then (TIO.hPutStr h msg) >> (return $ Tape msg)
- else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName]
-
-binopFold :: Binary -> Expr -> [Expr] -> Eval Expr
-binopFold op farg args = case args of
- []-> throw $ NumArgs 2 args
- [a,b] -> op a b
- _ -> foldM op farg args
-
-numBool :: (Integer -> Bool) -> Expr -> Eval Expr
-numBool op (Numb x) = return $ Bool $ op x
-numBool _ x = throw $ TypeMismatch "numeric op " x
-
-numOp :: (Integer -> Integer -> Integer) -> Expr -> Expr -> Eval Expr
-numOp op (Numb x) (Numb y) = return $ Numb $ op x y
-numOp _ Nil (Numb y) = return $ Numb y
-numOp _ (Numb x) Nil = return $ Numb x
-numOp _ x (Numb _) = throw $ TypeMismatch "numeric op" x
-numOp _ (Numb _) y = throw $ TypeMismatch "numeric op" y
-numOp _ x _ = throw $ TypeMismatch "numeric op" x
-
-strOp :: (T.Text -> T.Text -> T.Text) -> Expr -> Expr -> Eval Expr
-strOp op (Tape x) (Tape y) = return $ Tape $ op x y
-strOp _ Nil (Tape y) = return $ Tape y
-strOp _ (Tape x) Nil = return $ Tape x
-strOp _ x (Tape _) = throw $ TypeMismatch "string op" x
-strOp _ (Tape _) y = throw $ TypeMismatch "string op" y
-strOp _ x _ = throw $ TypeMismatch "string op" x
-
-eqOp :: (Bool -> Bool -> Bool) -> Expr -> Expr -> Eval Expr
-eqOp op (Bool x) (Bool y) = return $ Bool $ op x y
-eqOp _ x (Bool _) = throw $ TypeMismatch "bool op" x
-eqOp _ (Bool _) y = throw $ TypeMismatch "bool op" y
-eqOp _ x _ = throw $ TypeMismatch "bool op" x
-
-numCmp :: (Integer -> Integer -> Bool) -> Expr -> Expr -> Eval Expr
-numCmp op (Numb x) (Numb y) = return . Bool $ op x y
-numCmp _ x (Numb _) = throw $ TypeMismatch "numeric op" x
-numCmp _ (Numb _) y = throw $ TypeMismatch "numeric op" y
-numCmp _ x _ = throw $ TypeMismatch "numeric op" x
-
-notOp :: Expr -> Eval Expr
-notOp (Bool True) = return $ Bool False
-notOp (Bool False) = return $ Bool True
-notOp x = throw $ TypeMismatch " not expects Bool" x
-
-eqCmd :: Expr -> Expr -> Eval Expr
-eqCmd (Atom x) (Atom y) = return . Bool $ x == y
-eqCmd (Numb x) (Numb y) = return . Bool $ x == y
-eqCmd (Tape x) (Tape y) = return . Bool $ x == y
-eqCmd (Bool x) (Bool y) = return . Bool $ x == y
-eqCmd Nil Nil = return $ Bool True
-eqCmd _ _ = return $ Bool False
-
-cons :: [Expr] -> Eval Expr
-cons [x,(List ys)] = return $ List $ x:ys
-cons [x,y] = return $ List [x,y]
-cons _ = throw $ ExpectedList "cons, in second argument"
-
-car :: [Expr] -> Eval Expr
-car [List [] ] = return Nil
-car [List (x:_)] = return x
-car [] = return Nil
-car _ = throw $ ExpectedList "car"
-
-cdr :: [Expr] -> Eval Expr
-cdr [List (_:xs)] = return $ List xs
-cdr [List []] = return Nil
-cdr [] = return Nil
-cdr _ = throw $ ExpectedList "cdr"
-
-quote :: [Expr] -> Eval Expr
-quote [List xs] = return $ List $ Atom "quote" : xs
-quote [expr] = return $ List $ Atom "quote" : [expr]
-quote args = throw $ NumArgs 1 args
diff --git a/com/simatime/language/bs/repl.hs b/com/simatime/language/bs/repl.hs
deleted file mode 100644
index 64ffaa2..0000000
--- a/com/simatime/language/bs/repl.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Language.Bs.Repl (
-mainLoop
-) where
-
-import Control.Monad.Trans
-import Data.String
-import Data.Text as T
-import Language.Bs.Eval
-import Protolude
-import System.Console.Haskeline
-
-type Repl a = InputT IO a
-
-mainLoop :: IO ()
-mainLoop = runInputT defaultSettings repl
-
-repl :: Repl ()
-repl = do
- minput <- getInputLine "bs> "
- case minput of
- Nothing -> outputStrLn "bye."
- Just input -> (liftIO $ process input) >> repl
- --Just input -> (liftIO $ processToAST input) >> repl
-
-process :: String -> IO ()
-process str = do
- res <- safeExec $ evalText $ T.pack str
- either putStrLn return res
-
-processToAST :: String -> IO ()
-processToAST str = print $ runParseTest $ T.pack str
diff --git a/com/simatime/language/bs/test.hs b/com/simatime/language/bs/test.hs
deleted file mode 100644
index 4a40036..0000000
--- a/com/simatime/language/bs/test.hs
+++ /dev/null
@@ -1,2 +0,0 @@
--- TODO
-module Language.Bs.Test where
diff --git a/com/simatime/mail.nix b/com/simatime/mail.nix
deleted file mode 100644
index 81bddc2..0000000
--- a/com/simatime/mail.nix
+++ /dev/null
@@ -1,43 +0,0 @@
-{ ... }:
-
-{
- mailserver = {
- enable = true;
- monitoring = {
- enable = false;
- alertAddress = "bsima@me.com";
- };
- fqdn = "simatime.com";
- domains = [ "simatime.com" "bsima.me" ];
- certificateScheme = 3; # let's encrypt
- enableImap = true;
- enablePop3 = true;
- enableImapSsl = true;
- enablePop3Ssl = true;
- enableManageSieve = true;
- virusScanning = false; # ur on ur own
- localDnsResolver = true;
-
- loginAccounts = {
- "ben@simatime.com" = {
- hashedPassword = "$6$Xr180W0PqprtaFB0$9S/Ug1Yz11CaWO7UdVJxQLZWfRUE3/rarB0driXkXALugEeQDLIjG2STGQBLU23//JtK3Mz8Kwsvg1/Zo0vD2/";
- aliases = [
- # my default email
- "ben@bsima.me"
- # admin stuff
- "postmaster@simatime.com"
- "abuse@simatime.com"
- ];
- catchAll = [ "simatime.com" "bsima.me" ];
- quota = "5G";
- };
- "nick@simatime.com" = {
- hashedPassword = "$6$31P/Mg8k8Pezy1e$Fn1tDyssf.1EgxmLYFsQpSq6RP4wbEvP/UlBlXQhyKA9FnmFtJteXsbJM1naa8Kyylo8vZM9zmeoSthHS1slA1";
- aliases = [
- "nicolai@simatime.com"
- ];
- quota = "1G";
- };
- };
- };
-}
diff --git a/com/simatime/network.hs b/com/simatime/network.hs
deleted file mode 100644
index e47e891..0000000
--- a/com/simatime/network.hs
+++ /dev/null
@@ -1,31 +0,0 @@
--- | A port of Kris Jenkins' RemoteData Elm module
--- <https://github.com/krisajenkins/remotedata>.
---
-module Com.Simatime.Network where
-
-data RemoteData a b
- = NotAsked
- | Loading
- | Failure a
- | Success b
- deriving (Eq, Show)
-
--- TODO figure out Http.Error
--- type WebData a = RemoteData Http.Error a
-
-instance Functor (RemoteData a) where
- fmap _ NotAsked = NotAsked
- fmap _ Loading = Loading
- fmap _ (Failure a) = Failure a
- fmap f (Success a) = Success (f a)
-
-instance Applicative (RemoteData e) where
- pure = Success
- NotAsked <*> _ = NotAsked
- Loading <*> _ = Loading
- Failure a <*> _ = Failure a
- Success a <*> b = fmap a b
-
-fromEither :: Either a b -> RemoteData a b
-fromEither (Left a) = Failure a
-fromEither (Right a) = Success a
diff --git a/com/simatime/networking.nix b/com/simatime/networking.nix
deleted file mode 100644
index f634187..0000000
--- a/com/simatime/networking.nix
+++ /dev/null
@@ -1,36 +0,0 @@
-{ lib, config, ... }:
-
-{
- networking = {
- hostName = "simatime";
- firewall = {
- allowedTCPPorts = [ 22 80 443 ];
- allowPing = true;
- };
-
- # This following was populated at runtime with the networking details
- # gathered from the active system.
- nameservers = [
- "67.207.67.2"
- "67.207.67.3"
- ];
- defaultGateway = "159.89.128.1";
- defaultGateway6 = "";
- dhcpcd.enable = false;
- usePredictableInterfaceNames = lib.mkForce true;
- interfaces = {
- eth0 = {
- ipv4.addresses = [
- { address="159.89.128.69"; prefixLength=20; }
- { address="10.46.0.6"; prefixLength=16; }
- ];
- ipv6.addresses = [
- { address="fe80::e899:c0ff:fe9c:e194"; prefixLength=64; }
- ];
- };
- };
- };
- services.udev.extraRules = ''
- ATTR{address}=="ea:99:c0:9c:e1:94", NAME="eth0"
- '';
-}
diff --git a/com/simatime/nixpkgs.nix b/com/simatime/nixpkgs.nix
deleted file mode 100644
index 5d8dc56..0000000
--- a/com/simatime/nixpkgs.nix
+++ /dev/null
@@ -1,5 +0,0 @@
-# generated with ~/bin/nix-pin
-{
- url = "https://github.com/NixOS/nixpkgs/archive/0715f2f1a9b3a1c15ddf3f7386a6d58c9a1bbe2d.tar.gz";
- sha256 = "0awm087hnsx0x5phxna5a0cm9ir6m7vha94b0q0zq5lb24clgr6s";
-}
diff --git a/com/simatime/packages.nix b/com/simatime/packages.nix
deleted file mode 100644
index 920d19d..0000000
--- a/com/simatime/packages.nix
+++ /dev/null
@@ -1,12 +0,0 @@
-{ pkgs, ... }:
-
-{
- environment.systemPackages = [
- pkgs.wget
- pkgs.ranger
- pkgs.vnstat
- pkgs.gitAndTools.gitFull
- pkgs.tinc_pre
- pkgs.python3
- ];
-}
diff --git a/com/simatime/repl.scm b/com/simatime/repl.scm
deleted file mode 100644
index bae7e8f..0000000
--- a/com/simatime/repl.scm
+++ /dev/null
@@ -1,23 +0,0 @@
-(define-module (com simatime repl)
- #:export ())
-
-
-;;
-;; repl customization
-;;
-
-;; (use-modules (system repl common))
-;; (repl-default-option-set!
-;; 'prompt
-;; (lambda (repl)
-;; (format #f "\n[~a@~a:~a]\nλ> "
-;; (getenv "USER")
-;; (vector-ref (uname) 1)
-;; (pwd))))
-
-;; TODO(bsima): (doc x)
-;; TODO(bsima): (src x)
-;; TODO(bsima): ,src command
-;; TODO(bsima): ,shell command
-;; TODO(bsima): how to load this file on startup?
-;; for ,src and ,shell https://github.com/NalaGinrut/nala-repl
diff --git a/com/simatime/sema.hs b/com/simatime/sema.hs
deleted file mode 100644
index f0f75da..0000000
--- a/com/simatime/sema.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Com.Simatime.Sema
- ( mapPool
- )
-where
-
-import qualified Control.Concurrent.MSem as Sem
-
--- | Simaphore-based throttled 'mapConcurrently'.
-mapPool :: Traversable t => Int -> (a -> IO b) -> t a -> IO (t b)
-mapPool n f xs = do
- sima <- Sem.new n
- mapConcurrently (Sem.with sima . f) xs
diff --git a/com/simatime/shell.scm b/com/simatime/shell.scm
deleted file mode 100644
index 7c6bb5c..0000000
--- a/com/simatime/shell.scm
+++ /dev/null
@@ -1,34 +0,0 @@
-(define-module (com simatime shell)
- #:use-module ((ice-9 popen) #:prefix popen/)
- #:use-module ((ice-9 rdelim) #:prefix rdelim/)
- #:use-module ((ice-9 ftw) #:prefix ftw/)
- #:export (exec
- stream
- pwd
- ls
- cd))
-
-(define (exec cmd)
- (let* ((port (popen/open-input-pipe cmd))
- (ret (read port)))
- (popen/close-pipe port)
- ret))
-
-(define (stream cmd)
- (let* ((port (popen/open-input-pipe cmd))
- (_ (setvbuf port 'none))
- (ret (rdelim/read-string port)))
- (flush-all-ports)
- (popen/close-pipe port)
- ret))
-
-(define (pwd)
- (regexp-substitute/global
- #f "/home/ben" (getcwd) 'pre "~" 'post))
-
-(define (ls)
- (ftw/scandir (getcwd)))
-
-(define (cd path)
- (chdir path)
- (ls))
diff --git a/com/simatime/shuffle.hs b/com/simatime/shuffle.hs
deleted file mode 100644
index 02cd3e0..0000000
--- a/com/simatime/shuffle.hs
+++ /dev/null
@@ -1,122 +0,0 @@
-{- |
-Module : System.Random.Shuffle
-Copyright : (c) 2009 Oleg Kiselyov, Manlio Perillo
-License : BSD3 (see LICENSE file)
-
-<http://okmij.org/ftp/Haskell/perfect-shuffle.txt>
-
-
-Example:
-
- import System.Random (newStdGen)
- import System.Random.Shuffle (shuffle')
-
- main = do
- rng <- newStdGen
- let xs = [1,2,3,4,5]
- print $ shuffle' xs (length xs) rng
--}
-{-# OPTIONS_GHC -funbox-strict-fields #-}
-
-module System.Random.Shuffle
- ( shuffle
- , shuffle'
- , shuffleM
- )
-where
-
-import Data.Function ( fix )
-import System.Random ( RandomGen
- , randomR
- )
-import Control.Monad ( liftM
- , liftM2
- )
-import Control.Monad.Random ( MonadRandom
- , getRandomR
- )
-
-
--- | A complete binary tree, of leaves and internal nodes.
--- Internal node: Node card l r
--- where card is the number of leaves under the node.
--- Invariant: card >=2. All internal tree nodes are always full.
-data Tree a = Leaf !a
- | Node !Int !(Tree a) !(Tree a)
- deriving Show
-
-
--- | Convert a sequence (e1...en) to a complete binary tree
-buildTree :: [a] -> Tree a
-buildTree = (fix growLevel) . (map Leaf)
- where
- growLevel _ [node] = node
- growLevel self l = self $ inner l
-
- inner [] = []
- inner [e ] = [e]
- inner (e1 : e2 : es) = e1 `seq` e2 `seq` (join e1 e2) : inner es
-
- join l@(Leaf _ ) r@(Leaf _ ) = Node 2 l r
- join l@(Node ct _ _ ) r@(Leaf _ ) = Node (ct + 1) l r
- join l@(Leaf _ ) r@(Node ct _ _) = Node (ct + 1) l r
- join l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl + ctr) l r
-
-
--- |Given a sequence (e1,...en) to shuffle, and a sequence
--- (r1,...r[n-1]) of numbers such that r[i] is an independent sample
--- from a uniform random distribution [0..n-i], compute the
--- corresponding permutation of the input sequence.
-shuffle :: [a] -> [Int] -> [a]
-shuffle elements = shuffleTree (buildTree elements)
- where
- shuffleTree (Leaf e) [] = [e]
- shuffleTree tree (r : rs) =
- let (b, rest) = extractTree r tree in b : (shuffleTree rest rs)
- shuffleTree _ _ = error "[shuffle] called with lists of different lengths"
-
- -- Extracts the n-th element from the tree and returns
- -- that element, paired with a tree with the element
- -- deleted.
- -- The function maintains the invariant of the completeness
- -- of the tree: all internal nodes are always full.
- extractTree 0 (Node _ (Leaf e) r ) = (e, r)
- extractTree 1 (Node 2 (Leaf l) (Leaf r)) = (r, Leaf l)
- extractTree n (Node c (Leaf l) r) =
- let (e, r') = extractTree (n - 1) r in (e, Node (c - 1) (Leaf l) r')
-
- extractTree n (Node n' l (Leaf e)) | n + 1 == n' = (e, l)
-
- extractTree n (Node c l@(Node cl _ _) r)
- | n < cl
- = let (e, l') = extractTree n l in (e, Node (c - 1) l' r)
- | otherwise
- = let (e, r') = extractTree (n - cl) r in (e, Node (c - 1) l r')
- extractTree _ _ = error "[extractTree] impossible"
-
--- |Given a sequence (e1,...en) to shuffle, its length, and a random
--- generator, compute the corresponding permutation of the input
--- sequence.
-shuffle' :: RandomGen gen => [a] -> Int -> gen -> [a]
-shuffle' elements len = shuffle elements . rseq len
- where
- -- The sequence (r1,...r[n-1]) of numbers such that r[i] is an
- -- independent sample from a uniform random distribution
- -- [0..n-i]
- rseq :: RandomGen gen => Int -> gen -> [Int]
- rseq n = fst . unzip . rseq' (n - 1)
- where
- rseq' :: RandomGen gen => Int -> gen -> [(Int, gen)]
- rseq' 0 _ = []
- rseq' i gen = (j, gen) : rseq' (i - 1) gen'
- where (j, gen') = randomR (0, i) gen
-
--- |shuffle' wrapped in a random monad
-shuffleM :: (MonadRandom m) => [a] -> m [a]
-shuffleM elements
- | null elements = return []
- | otherwise = liftM (shuffle elements) (rseqM (length elements - 1))
- where
- rseqM :: (MonadRandom m) => Int -> m [Int]
- rseqM 0 = return []
- rseqM i = liftM2 (:) (getRandomR (0, i)) (rseqM (i - 1))
diff --git a/com/simatime/string.scm b/com/simatime/string.scm
deleted file mode 100644
index 01c5a70..0000000
--- a/com/simatime/string.scm
+++ /dev/null
@@ -1,24 +0,0 @@
-(define-module (com simatime string)
- #:export (replace to-string str capitalize))
-
-(define (replace s match repl)
- (let ((f (lambda (a b)
- (let ((next-char (if (eq? a match) repl a)))
- (string-concatenate (list b (string next-char)))))))
- (string-fold f "" s)))
-
-(define (to-string x)
- (format #f "~a" x))
-
-(define str
- (case-lambda
- (() "")
- ((x) (to-string x))
- ((x . rest) (string-concatenate (map str (cons x rest))))))
-
-(define (capitalize s)
- (let ((s (to-string s)))
- (if (< (string-length s) 2)
- (string-upcase s)
- (str (string-upcase (substring s 0 1))
- (substring s 1 )))))
diff --git a/com/simatime/users.nix b/com/simatime/users.nix
deleted file mode 100644
index daac9d6..0000000
--- a/com/simatime/users.nix
+++ /dev/null
@@ -1,33 +0,0 @@
-{ ... }:
-
-let
- key = f: builtins.readFile (./keys/. + ("/" + f));
-in
-{
- users = {
- users = {
- # bots
- deploy = {
- isNormalUser = true;
- home = "/home/deploy";
- openssh.authorizedKeys.keys = [ (key "deploy.pub") ];
- extraGroups = [ "wheel" ];
- };
-
- # humans
- root.openssh.authorizedKeys.keys = [ (key "ben.pub") ];
- ben = {
- isNormalUser = true;
- home = "/home/ben";
- openssh.authorizedKeys.keys = [ (key "ben.pub") ];
- extraGroups = [ "wheel" "networkmanager" "docker" ];
- };
- nick = {
- isNormalUser = true;
- home = "/home/nick";
- openssh.authorizedKeys.keys = [ (key "nick.pub") ];
- extraGroups = [ "docker" ];
- };
- };
- };
-}
diff --git a/com/simatime/web.nix b/com/simatime/web.nix
deleted file mode 100644
index d6be348..0000000
--- a/com/simatime/web.nix
+++ /dev/null
@@ -1,41 +0,0 @@
-{ ... }:
-
-let
- bensIp = "69.181.254.154"; # hikuj-zupip
-in
-{
- services = {
- nginx = {
- enable = true;
- recommendedGzipSettings = true;
- recommendedOptimisation = true;
- recommendedProxySettings = true;
- recommendedTlsSettings = true;
- virtualHosts = {
- "bsima.me".root = "/home/ben/public_html/";
- "www.bsima.me".root = "/home/ben/public_html/";
- "simatime.com".locations."/".root = "/srv/www/";
- "firefoxsync.simatime.com".locations."/".proxyPass = "http://localhost:5001";
- "hero.simatime.com".locations."/".proxyPass = "http://${bensIp}:3001";
- "tv.simatime.com".locations."/".proxyPass = "http://${bensIp}:8096"; # emby runs on port 8096
- "deluge.simatime.com".locations."/".proxyPass = "http://${bensIp}:8112";
-
- "notebook.simatime.com".locations = {
- "/" = {
- proxyPass = "http://${bensIp}:3099";
- proxyWebsockets = true;
- extraConfig = ''
- proxy_buffering off;
- proxy_read_timeout 86400;
-
- '';
- };
- "/(api/kernels/[^/]+/channels|terminals/websocket)/" = {
- proxyPass = "http://${bensIp}:3099";
- proxyWebsockets = true;
- };
- };
- };
- };
- };
-}
diff --git a/com/simatime/znc.nix b/com/simatime/znc.nix
deleted file mode 100644
index 9b1a28d..0000000
--- a/com/simatime/znc.nix
+++ /dev/null
@@ -1,66 +0,0 @@
-/*
-
-N.B.: generate znc passwords with 'nix-shell -p znc --command "znc --makepass"'
-
-- https://wiki.znc.in/Configuration
-
-*/
-
-{ ... }:
-
-{
- services = {
- znc = {
- enable = true;
- mutable = false;
- useLegacyConfig = false;
- openFirewall = true;
- config = {
- LoadModule = [ "adminlog" ];
- User.bsima = {
- Admin = true;
- Nick = "bsima";
- AltNick = "bsima1";
- LoadModule = [ "chansaver" "controlpanel" "log" ];
- Network.freenode = {
- Server = "chat.freenode.net +6697";
- LoadModule = [ "simple_away" "nickserv" "sasl" ];
- Chan = {
- "#ai" = {};
- "#biz" = { Modes = "+Sp"; };
- "#bsima" = { Modes = "+Sp"; };
- "##categorytheory" = { Detached = true; };
- "#clojure" = { Detached = true; };
- "#coq" = { Detached = true; };
- "#emacs" = { Detached = true; };
- "#guile" = { Detached = true; };
- "#guix" = { Detached = true; };
- "#haskell" = {};
- "#haskell-miso" = { Detached = true; };
- "#hledger" = {};
- "#hnix" = { Detached = true; };
- "#home-manager" = { Detached = true; };
- "#ledger" = {};
- "#nix-darwin" = { Detached = true; };
- "#nixos" = {};
- "#org-mode" = {};
- "#scheme" = { Detached = true; };
- "#servant" = { Detached = true; };
- "#sr.ht" = { Detached = true; };
- "#xmonad" = { Detached = true; };
- };
- };
- Network.efnet = {
- Server = "irc.efnet.info +6697";
- LoadModule = [ "simple_away" ];
- };
- Pass.password = {
- Method = "sha256";
- Hash = "bead16d806e7bf5cbbc31d572b20f01e2b253eb60e2497ce465df56306becd02";
- Salt = "/GhmBMc+E6b7qd8muFEe";
- };
- };
- };
- };
- };
-}