diff options
Diffstat (limited to 'com/simatime')
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"; - }; - }; - }; - }; - }; -} |