From c790672cc244ac4caba1bda3572829a6c6862891 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 27 Oct 2019 09:48:52 -0700 Subject: move everything to namespace directories --- .gitignore | 4 +- .gitlab-ci.yml | 21 -- README.md | 66 ++--- aero/Ibb.hs | 21 -- apex/Bs.hs | 6 - apex/Cmdwave.hs | 10 - apex/Duree.hs | 6 - apex/Ibb.hs | 132 --------- bild/.keep | 0 com/influencedbybooks.nix | 42 +++ com/influencedbybooks/aero.hs | 21 ++ com/influencedbybooks/apex.hs | 132 +++++++++ com/influencedbybooks/core.hs | 129 +++++++++ com/influencedbybooks/default.nix | 32 +++ com/influencedbybooks/influencers.hs | 407 ++++++++++++++++++++++++++++ com/influencedbybooks/keep.hs | 124 +++++++++ com/influencedbybooks/look.hs | 27 ++ com/influencedbybooks/move.hs | 43 +++ com/simatime.nix | 60 ++++ com/simatime/alpha.hs | 24 ++ com/simatime/bild.scm | 145 ++++++++++ com/simatime/core.scm | 73 +++++ com/simatime/dev.nix | 20 ++ com/simatime/dev/configuration.nix | 215 +++++++++++++++ com/simatime/dev/hardware.nix | 34 +++ com/simatime/fathom.nix | 109 ++++++++ com/simatime/firefox.nix | 12 + com/simatime/git.nix | 18 ++ com/simatime/go.hs | 100 +++++++ com/simatime/hardware.nix | 6 + com/simatime/idea/duree-pitch.org | 80 ++++++ com/simatime/idea/flash.org | 36 +++ com/simatime/keys/ben.pub | 1 + com/simatime/keys/deploy.pub | 1 + com/simatime/keys/nick.pub | 1 + com/simatime/language/bs.hs | 12 + com/simatime/language/bs/cli.hs | 52 ++++ com/simatime/language/bs/eval.hs | 241 ++++++++++++++++ com/simatime/language/bs/expr.hs | 154 +++++++++++ com/simatime/language/bs/parser.hs | 121 +++++++++ com/simatime/language/bs/primitives.hs | 183 +++++++++++++ com/simatime/language/bs/repl.hs | 33 +++ com/simatime/language/bs/test.hs | 2 + com/simatime/mail.nix | 43 +++ com/simatime/network.hs | 31 +++ com/simatime/networking.nix | 38 +++ com/simatime/nixpkgs.nix | 5 + com/simatime/packages.nix | 11 + com/simatime/repl.scm | 34 +++ com/simatime/sema.hs | 12 + com/simatime/shuffle.hs | 122 +++++++++ com/simatime/users.nix | 33 +++ com/simatime/web.nix | 41 +++ com/simatime/znc.nix | 70 +++++ default.nix | 60 +++- depo/default.nix | 6 - depo/hikuj-zupip/configuration.nix | 215 --------------- depo/hikuj-zupip/default.nix | 23 -- depo/hikuj-zupip/hardware.nix | 34 --- depo/nutin-madaj/default.nix | 94 ------- depo/nutin-madaj/firefox.nix | 12 - depo/nutin-madaj/git.nix | 18 -- depo/nutin-madaj/hardware-configuration.nix | 6 - depo/nutin-madaj/mail.nix | 43 --- depo/nutin-madaj/networking.nix | 38 --- depo/nutin-madaj/web.nix | 41 --- depo/nutin-madaj/znc.nix | 70 ----- depo/packages.nix | 11 - depo/users.nix | 33 --- idea/duree-pitch.org | 80 ------ idea/flash.org | 36 --- keys/ben.pub | 1 - keys/deploy.pub | 1 - keys/nick.pub | 1 - lore/Alpha.hs | 24 -- lore/Biz/Ibb.hs | 9 - lore/Biz/Ibb/Core.hs | 129 --------- lore/Biz/Ibb/Influencers.hs | 407 ---------------------------- lore/Biz/Ibb/Keep.hs | 124 --------- lore/Biz/Ibb/Look.hs | 27 -- lore/Biz/Ibb/Move.hs | 43 --- lore/Control/Concurrent/Go.hs | 100 ------- lore/Control/Concurrent/Sima.hs | 12 - lore/Language/Bs.hs | 12 - lore/Language/Bs/Cli.hs | 52 ---- lore/Language/Bs/Eval.hs | 241 ---------------- lore/Language/Bs/Expr.hs | 154 ----------- lore/Language/Bs/Parser.hs | 121 --------- lore/Language/Bs/Primitives.hs | 183 ------------- lore/Language/Bs/Repl.hs | 33 --- lore/Language/Bs/Test.hs | 2 - lore/Network/RemoteData.hs | 31 --- lore/System/Random/Shuffle.hs | 122 --------- lore/bild.nix | 56 ---- lore/core.scm | 59 ---- lore/sicp/meta.scm | 20 -- lore/sicp/set.scm | 42 --- mode/fathom.nix | 93 ------- mode/ibb.nix | 42 --- nixpkgs.nix | 5 + pack/bs.nix | 39 --- pack/buildeasy.nix | 30 -- pack/cmdwave.nix | 30 -- pack/default.nix | 12 - pack/duree.nix | 33 --- pack/fathom.nix | 18 -- pack/ibb.nix | 31 --- pack/nixpkgs.nix | 5 - pack/overlay.nix | 3 - 109 files changed, 3216 insertions(+), 3347 deletions(-) delete mode 100644 .gitlab-ci.yml delete mode 100644 aero/Ibb.hs delete mode 100644 apex/Bs.hs delete mode 100644 apex/Cmdwave.hs delete mode 100644 apex/Duree.hs delete mode 100644 apex/Ibb.hs delete mode 100644 bild/.keep create mode 100644 com/influencedbybooks.nix create mode 100644 com/influencedbybooks/aero.hs create mode 100644 com/influencedbybooks/apex.hs create mode 100644 com/influencedbybooks/core.hs create mode 100644 com/influencedbybooks/default.nix create mode 100644 com/influencedbybooks/influencers.hs create mode 100644 com/influencedbybooks/keep.hs create mode 100644 com/influencedbybooks/look.hs create mode 100644 com/influencedbybooks/move.hs create mode 100644 com/simatime.nix create mode 100644 com/simatime/alpha.hs create mode 100644 com/simatime/bild.scm create mode 100644 com/simatime/core.scm create mode 100644 com/simatime/dev.nix create mode 100644 com/simatime/dev/configuration.nix create mode 100644 com/simatime/dev/hardware.nix create mode 100644 com/simatime/fathom.nix create mode 100644 com/simatime/firefox.nix create mode 100644 com/simatime/git.nix create mode 100644 com/simatime/go.hs create mode 100644 com/simatime/hardware.nix create mode 100644 com/simatime/idea/duree-pitch.org create mode 100644 com/simatime/idea/flash.org create mode 100644 com/simatime/keys/ben.pub create mode 100644 com/simatime/keys/deploy.pub create mode 100644 com/simatime/keys/nick.pub create mode 100644 com/simatime/language/bs.hs create mode 100644 com/simatime/language/bs/cli.hs create mode 100644 com/simatime/language/bs/eval.hs create mode 100644 com/simatime/language/bs/expr.hs create mode 100644 com/simatime/language/bs/parser.hs create mode 100644 com/simatime/language/bs/primitives.hs create mode 100644 com/simatime/language/bs/repl.hs create mode 100644 com/simatime/language/bs/test.hs create mode 100644 com/simatime/mail.nix create mode 100644 com/simatime/network.hs create mode 100644 com/simatime/networking.nix create mode 100644 com/simatime/nixpkgs.nix create mode 100644 com/simatime/packages.nix create mode 100644 com/simatime/repl.scm create mode 100644 com/simatime/sema.hs create mode 100644 com/simatime/shuffle.hs create mode 100644 com/simatime/users.nix create mode 100644 com/simatime/web.nix create mode 100644 com/simatime/znc.nix delete mode 100644 depo/default.nix delete mode 100644 depo/hikuj-zupip/configuration.nix delete mode 100644 depo/hikuj-zupip/default.nix delete mode 100644 depo/hikuj-zupip/hardware.nix delete mode 100644 depo/nutin-madaj/default.nix delete mode 100644 depo/nutin-madaj/firefox.nix delete mode 100644 depo/nutin-madaj/git.nix delete mode 100644 depo/nutin-madaj/hardware-configuration.nix delete mode 100644 depo/nutin-madaj/mail.nix delete mode 100644 depo/nutin-madaj/networking.nix delete mode 100644 depo/nutin-madaj/web.nix delete mode 100644 depo/nutin-madaj/znc.nix delete mode 100644 depo/packages.nix delete mode 100644 depo/users.nix delete mode 100644 idea/duree-pitch.org delete mode 100644 idea/flash.org delete mode 100644 keys/ben.pub delete mode 100644 keys/deploy.pub delete mode 100644 keys/nick.pub delete mode 100644 lore/Alpha.hs delete mode 100644 lore/Biz/Ibb.hs delete mode 100644 lore/Biz/Ibb/Core.hs delete mode 100644 lore/Biz/Ibb/Influencers.hs delete mode 100644 lore/Biz/Ibb/Keep.hs delete mode 100644 lore/Biz/Ibb/Look.hs delete mode 100644 lore/Biz/Ibb/Move.hs delete mode 100644 lore/Control/Concurrent/Go.hs delete mode 100644 lore/Control/Concurrent/Sima.hs delete mode 100644 lore/Language/Bs.hs delete mode 100644 lore/Language/Bs/Cli.hs delete mode 100644 lore/Language/Bs/Eval.hs delete mode 100644 lore/Language/Bs/Expr.hs delete mode 100644 lore/Language/Bs/Parser.hs delete mode 100644 lore/Language/Bs/Primitives.hs delete mode 100644 lore/Language/Bs/Repl.hs delete mode 100644 lore/Language/Bs/Test.hs delete mode 100644 lore/Network/RemoteData.hs delete mode 100644 lore/System/Random/Shuffle.hs delete mode 100644 lore/bild.nix delete mode 100644 lore/core.scm delete mode 100644 lore/sicp/meta.scm delete mode 100644 lore/sicp/set.scm delete mode 100644 mode/fathom.nix delete mode 100644 mode/ibb.nix create mode 100644 nixpkgs.nix delete mode 100644 pack/bs.nix delete mode 100644 pack/buildeasy.nix delete mode 100644 pack/cmdwave.nix delete mode 100644 pack/default.nix delete mode 100644 pack/duree.nix delete mode 100644 pack/fathom.nix delete mode 100644 pack/ibb.nix delete mode 100644 pack/nixpkgs.nix delete mode 100644 pack/overlay.nix diff --git a/.gitignore b/.gitignore index cfa2ad1..e8e7a6f 100644 --- a/.gitignore +++ b/.gitignore @@ -2,9 +2,7 @@ *.exe *.hi result* -dist -dist-newstyle -bild/* +_bild TAGS .tex .pdf diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml deleted file mode 100644 index f429ee2..0000000 --- a/.gitlab-ci.yml +++ /dev/null @@ -1,21 +0,0 @@ -stages: - - build - -before_script: - - nix --version - - nix-channel --list - - pwd - - ls -al - - -build-pack: - stage: build - script: nix-build -A pack - tags: - - nix - -build-depo: - stage: build - script: nix-build -A depo - tags: - - nix diff --git a/README.md b/README.md index f3f3a28..355a12e 100644 --- a/README.md +++ b/README.md @@ -1,40 +1,27 @@ -# Source layout +# Source Layout - aero browser apps, compiled with ghcjs - apex server-side api stuff, compiled with ghc - bild temporary storage for build artifacts - chip executable scripts in python, bash - depo for deployment, machine-specific nix code - lore shared libraries, compiled with either ghc/js - mode nixos modules; services and modular config - pack nix packages & external packages that we import - soar s3/spaces assets, like images, via git-annex +The source tree maps to the DNS namespace that we own. The purpose of this +mapping is to keep things organized hierarchically in how they are deployed on +the Internet. The main 'common' space is `com.simatime`, everything else should +be related to the application. -This isn't totally in place yet, but it's something to work toward. +Development aspects should be localized to their sub-namespaces as much as +possible. Only after sufficient iteration such that interfaces are solidified +and functionality is well-established should some code be promoted up the +namespace hierarchy. -The main source directory is `lore`. Stuff in `aero` and `apex` should be small -functions specific to the server/client. +Boundaries and interfaces between namespaces should be small and +well-defined. Likewise, the functionality and purpose of a particular namespace +should be small and well-defined. Following the unix principle of "do one thing +and do it well" is advised. -The two special locations are `soar` and `bild`. The former is for images and -other assets to be synced to digital ocean's object storage. The latter's -contents are gitignore'd and can be deleted at any time because they will just -be rebuilt later. +Namespaces refer to conceptual boundaries. Implementations can be in any number +of languages, indicated by the file extension. For example, we can have +`com.example.api.hs` and `com.example.api.scm` in order to have an API client in +both Haskell and Scheme. Building `com.example.api` should compile both pieces +of code. -# Development - -To get a development shell, for example to work on ibb, you can do: - - $ nix-shell -A pack.ibb - $ chip/make ibb - -The build system topology is defined in `./default.nix`, so follow the import -paths there to see what's available for building and installing locally. For -example, to build `ibb`: `nix-build -A pack.ibb`. Or, to build the main app -server with all dependencies and configuration: `nix-build -A -depo.nutin-madaj.system`. Omitting `.system` will also build a VM that you can -run locally for testing. - -## Goals of the developer workflow: +# Goals of the developer workflow: - have minimal ceremony - default to asynchrony, but allow for synchronous work when necessary @@ -45,19 +32,16 @@ run locally for testing. Ideally, each contributor should be able to go off grid for a day or a week or more, continue working offline, submit their work when finished, and have no or -minimal conflicts. This also refers to the resiliance of the production systems. +minimal conflicts. This also refers to the resilience of the production systems. We should never need "out of office" email auto-replies, or urgent contact. No -pager duy, no daily standups. Yes, this policy will affect what code we write, +pager duty, no daily stand-ups. Yes, this policy will affect what code we write, not just how we write it; that is by design. -# Deployment - -To build the production server config locally: +## Org - nix-build -A depo.nutin-madaj.system +## Git -To push the built closure and switch to the new configuration (will ask for ssh -passphrase 2x): +## Email - chip/push nutin-madaj +## IRC diff --git a/aero/Ibb.hs b/aero/Ibb.hs deleted file mode 100644 index 705abef..0000000 --- a/aero/Ibb.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE NoImplicitPrelude #-} - --- | Front-end -module Ibb where - -import Alpha -import Biz.Ibb.Move (move) -import Biz.Ibb.Core (Action(..), see, init) -import Miso (App(..), defaultEvents, miso) - -main :: IO () -main = miso $ \u -> App { model = init u, .. } - where - initialAction = FetchPeople - update = move - view = see - events = defaultEvents - subs = [] - mountPoint = Nothing diff --git a/apex/Bs.hs b/apex/Bs.hs deleted file mode 100644 index 0f57bc3..0000000 --- a/apex/Bs.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Bs where - -import Language.Bs.Cli (run) - -main :: IO () -main = run diff --git a/apex/Cmdwave.hs b/apex/Cmdwave.hs deleted file mode 100644 index dfd9fcb..0000000 --- a/apex/Cmdwave.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Cmdwave where - -import Sound.Pulse.Simple - -main :: IO () -main = do - s <- simpleNew Nothing "example" Record Nothing "this is an example application" - (SampleSpec (F32 LittleEndian) 44100 1) Nothing Nothing - _ <- simpleRead s $ 44100*10 :: IO [Float] - simpleFree s diff --git a/apex/Duree.hs b/apex/Duree.hs deleted file mode 100644 index 4552834..0000000 --- a/apex/Duree.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Duree where - -import Database.MongoDB - -main :: IO () -main = putStrLn "hi" diff --git a/apex/Ibb.hs b/apex/Ibb.hs deleted file mode 100644 index 00fa349..0000000 --- a/apex/Ibb.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} - --- | Server -module Ibb where - -import Alpha -import Biz.Ibb -import qualified Biz.Ibb.Keep as Keep -import qualified Biz.Ibb.Look as Look -import qualified Clay -import qualified Data.Text.Lazy as Lazy -import qualified Data.Text.Lazy.Encoding as Lazy -import Data.Maybe (fromMaybe) -import Data.Acid (AcidState) -import qualified Data.Acid.Abstract as Acid -import GitHash (giHash, tGitInfoCwd) -import qualified Lucid as L -import Lucid.Base -import Miso -import Network.HTTP.Media ((//), (/:)) -import Network.HTTP.Types -import Network.RemoteData -import Network.Wai -import Network.Wai.Application.Static -import Network.Wai.Handler.Warp -import Network.Wai.Middleware.Gzip -import Network.Wai.Middleware.RequestLogger -import Servant -import System.Environment (lookupEnv) - -main :: IO () -main = do - say "rise: ibb" - port <- read - <$> fromMaybe "3000" - <$> lookupEnv "PORT" :: IO Int - keep <- Keep.openLocal "keep/" - say "port: 3000" - run port $ logStdout $ compress $ app $ keep - where - compress = gzip def { gzipFiles = GzipCompress } - -newtype HtmlPage a = HtmlPage a - deriving (Show, Eq) - -instance L.ToHtml a => L.ToHtml (HtmlPage a) where - toHtmlRaw = L.toHtml - toHtml (HtmlPage x) = - L.doctypehtml_ $ do - L.head_ $ do - L.meta_ [L.charset_ "utf-8"] - jsRef "/static/all.js" - cssRef "/css/main.css" - L.body_ $ do - page - L.p_ gitCommit - where - page = L.toHtml x - gitCommit = L.toHtml $ giHash $$tGitInfoCwd - jsRef href = L.with (L.script_ mempty) - [ makeAttribute "src" href - , makeAttribute "type" "text/javascript" - , makeAttribute "async" mempty - , makeAttribute "defer" mempty - ] - cssRef href = L.with - (L.link_ mempty) - [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href] - -type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action - -handle404 :: Application -handle404 _ respond = respond - $ responseLBS status404 [("Content-Type", "text/html")] - $ renderBS - $ toHtml - $ HtmlPage - $ notfound - -newtype CSS = CSS { unCSS :: Text } - -instance MimeRender CSS Text where - mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict - -instance Accept CSS where - contentType _ = "text" // "css" /: ("charset", "utf-8") - -type CssRoute = "css" :> "main.css" :> Get '[CSS] Text - -type Routes - = "static" :> Raw - :<|> CssRoute - :<|> ServerRoutes - :<|> "api" :> ApiRoutes - :<|> Raw - -cssHandlers :: Server CssRoute -cssHandlers = return . Lazy.toStrict . Clay.render - $ Look.main - -app :: AcidState Keep.IbbKeep -> Application -app keep = serve - (Proxy @Routes) - $ static - :<|> cssHandlers - :<|> serverHandlers - :<|> apiHandlers keep - :<|> Tagged handle404 - where - static = serveDirectoryWith (defaultWebAppSettings "ibb.jsexe") - -type ApiRoutes = - "people" :> Get '[JSON] [Person] - -serverHandlers :: Server ServerRoutes -serverHandlers = homeHandler - where - send f u = - pure $ HtmlPage $ f Model { uri = u, people = NotAsked } - homeHandler = send home goHome - --- | for now we just have one api endpoint, which returns all the people -apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes -apiHandlers keep = - Acid.query' keep $ Keep.GetPeople 20 diff --git a/bild/.keep b/bild/.keep deleted file mode 100644 index e69de29..0000000 diff --git a/com/influencedbybooks.nix b/com/influencedbybooks.nix new file mode 100644 index 0000000..f9d0f36 --- /dev/null +++ b/com/influencedbybooks.nix @@ -0,0 +1,42 @@ +{ options +, lib +, config +, pkgs +, modulesPath +}: + +let + cfg = config.services.ibb; +in +{ + options.services.ibb = { + enable = lib.mkEnableOption "Enable the IBB service"; + port = lib.mkOption { + type = lib.types.string; + default = "3000"; + description = '' + The port on which IBB will listen for + incoming HTTP traffic. + ''; + }; + }; + config = lib.mkIf cfg.enable { + systemd.services.ibb = { + path = with pkgs; [ ibb bash ]; + wantedBy = [ "multi-user.target" ]; + script = '' + PORT=${cfg.port} ./bin/ibb + ''; + description = '' + Influenced By Books website + ''; + serviceConfig = { + WorkingDirectory = pkgs.ibb; + KillSignal = "INT"; + Type = "simple"; + Restart = "on-abort"; + RestartSec = "10"; + }; + }; + }; +} diff --git a/com/influencedbybooks/aero.hs b/com/influencedbybooks/aero.hs new file mode 100644 index 0000000..92d071d --- /dev/null +++ b/com/influencedbybooks/aero.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Front-end +module Com.InfluencedByBooks.Aero where + +import Com.Simatime.Alpha +import Com.InfluencedByBooks.Move (move) +import Com.InfluencedByBooks.Core (Action(..), see, init) +import Miso (App(..), defaultEvents, miso) + +main :: IO () +main = miso $ \u -> App { model = init u, .. } + where + initialAction = FetchPeople + update = move + view = see + events = defaultEvents + subs = [] + mountPoint = Nothing diff --git a/com/influencedbybooks/apex.hs b/com/influencedbybooks/apex.hs new file mode 100644 index 0000000..fd4766b --- /dev/null +++ b/com/influencedbybooks/apex.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +-- | Server +module Com.InfluencedByBooks.Apex where + +import Com.Simatime Alpha +import Com.InfluencedByBooks.Core +import qualified Com.InfluencedByBooks.Keep as Keep +import qualified Com.InfluencedByBooks.Look as Look +import qualified Clay +import qualified Data.Text.Lazy as Lazy +import qualified Data.Text.Lazy.Encoding as Lazy +import Data.Maybe (fromMaybe) +import Data.Acid (AcidState) +import qualified Data.Acid.Abstract as Acid +import GitHash (giHash, tGitInfoCwd) +import qualified Lucid as L +import Lucid.Base +import Miso +import Network.HTTP.Media ((//), (/:)) +import Network.HTTP.Types +import Network.RemoteData +import Network.Wai +import Network.Wai.Application.Static +import Network.Wai.Handler.Warp +import Network.Wai.Middleware.Gzip +import Network.Wai.Middleware.RequestLogger +import Servant +import System.Environment (lookupEnv) + +main :: IO () +main = do + say "rise: ibb" + port <- read + <$> fromMaybe "3000" + <$> lookupEnv "PORT" :: IO Int + keep <- Keep.openLocal "keep/" + say "port: 3000" + run port $ logStdout $ compress $ app $ keep + where + compress = gzip def { gzipFiles = GzipCompress } + +newtype HtmlPage a = HtmlPage a + deriving (Show, Eq) + +instance L.ToHtml a => L.ToHtml (HtmlPage a) where + toHtmlRaw = L.toHtml + toHtml (HtmlPage x) = + L.doctypehtml_ $ do + L.head_ $ do + L.meta_ [L.charset_ "utf-8"] + jsRef "/static/all.js" + cssRef "/css/main.css" + L.body_ $ do + page + L.p_ gitCommit + where + page = L.toHtml x + gitCommit = L.toHtml $ giHash $$tGitInfoCwd + jsRef href = L.with (L.script_ mempty) + [ makeAttribute "src" href + , makeAttribute "type" "text/javascript" + , makeAttribute "async" mempty + , makeAttribute "defer" mempty + ] + cssRef href = L.with + (L.link_ mempty) + [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href] + +type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action + +handle404 :: Application +handle404 _ respond = respond + $ responseLBS status404 [("Content-Type", "text/html")] + $ renderBS + $ toHtml + $ HtmlPage + $ notfound + +newtype CSS = CSS { unCSS :: Text } + +instance MimeRender CSS Text where + mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict + +instance Accept CSS where + contentType _ = "text" // "css" /: ("charset", "utf-8") + +type CssRoute = "css" :> "main.css" :> Get '[CSS] Text + +type Routes + = "static" :> Raw + :<|> CssRoute + :<|> ServerRoutes + :<|> "api" :> ApiRoutes + :<|> Raw + +cssHandlers :: Server CssRoute +cssHandlers = return . Lazy.toStrict . Clay.render + $ Look.main + +app :: AcidState Keep.IbbKeep -> Application +app keep = serve + (Proxy @Routes) + $ static + :<|> cssHandlers + :<|> serverHandlers + :<|> apiHandlers keep + :<|> Tagged handle404 + where + static = serveDirectoryWith (defaultWebAppSettings "ibb.jsexe") + +type ApiRoutes = + "people" :> Get '[JSON] [Person] + +serverHandlers :: Server ServerRoutes +serverHandlers = homeHandler + where + send f u = + pure $ HtmlPage $ f Model { uri = u, people = NotAsked } + homeHandler = send home goHome + +-- | for now we just have one api endpoint, which returns all the people +apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes +apiHandlers keep = + Acid.query' keep $ Keep.GetPeople 20 diff --git a/com/influencedbybooks/core.hs b/com/influencedbybooks/core.hs new file mode 100644 index 0000000..9bd2353 --- /dev/null +++ b/com/influencedbybooks/core.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Main app logic +module Com.InfluencedByBooks.Core where + +import Com.Simatime.Alpha +import Data.Aeson hiding (Success) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import GHC.Generics (Generic) +import Miso +import Miso.String +import Com.Simatime.Network +import Servant.API +import Servant.Links + +-- * entity data types + +data Person = Person + { _name :: Text + -- ^ Their full name. + , _pic :: Text + -- ^ A link to their picture. + , _twitter :: Text + -- ^ Their twitter handle, without the `@` prefix. + , _website :: Text + -- ^ Their main website, fully formed: `https://example.com` + , _books :: [Book] + -- ^ A short list of the books they recommend. + , _blurb :: Text + -- ^ A short "about" section, like you would see on the jacket flap of a book. + } deriving (Generic, Show, Eq, Typeable, Data, Ord) + +instance FromJSON Person +instance ToJSON Person + +data Book = Book + { _title :: Text + , _author :: Text + , _amznref :: Text + -- ^ Amazon REF number, for creating affiliate links. + } deriving (Generic, Show, Eq, Typeable, Data, Ord) + +instance FromJSON Book +instance ToJSON Book + +-- * app data types + +type AppRoutes = Home + +type Home = View Action + +data Model = Model + { uri :: URI + , people :: WebData [Person] + } deriving (Show, Eq) + +type WebData a = RemoteData MisoString a + +init :: URI -> Model +init u = Model u Loading + +data Action + = Nop + | ChangeRoute URI + | HandleRoute URI + | FetchPeople + | SetPeople (WebData [Person]) + deriving (Show, Eq) + +home :: Model -> View Action +home m = see m + +handlers :: Model -> View Action +handlers = home + +notfound :: View Action +notfound = div_ [] [ text "404" ] + +goHome :: URI +goHome = linkURI $ safeLink + (Proxy :: Proxy AppRoutes) + (Proxy :: Proxy Home) + +see :: Model -> View Action +see m = div_ [ class_ "container mt-5" ] + [ div_ [ class_ "jumbotron" ] + [ h1_ [ class_ "display-4" ] [ text "Influenced by books" ] + , p_ [ class_ "lead" ] [ text "Influential people and the books that made them." ] + , p_ [ class_ "lead" ] + [ a_ [ href_ "http://eepurl.com/ghBFjv" ] + [ text "Get new book recommendations from the world's influencers in your email." ] + ] + ] + , div_ [ class_ "card-columns" ] $ case people m of + NotAsked -> [ text "Initializing..." ] + Loading -> [ text "Loading..." ] + Failure err -> [ text err ] + Success ps -> seePerson /@ ps + ] + +seePerson :: Person -> View Action +seePerson person = div_ [ class_ "card" ] + [ div_ [ class_ "card-img" ] + [ img_ [ class_ "card-img img-fluid", src_ $ ms $ _pic person ]] + , div_ [ class_ "card-body" ] + [ h4_ [ class_ "card-title" ] [ text $ ms $ _name person ] + , h6_ [] [ a_ [ class_ "fab fa-twitter" + , href_ $ "https://twitter.com/" <> (ms $ _twitter person) ] [] + , a_ [ class_ "fas fa-globe", href_ $ ms $ _website person ] [] + ] + , p_ [ class_ "card-text" ] + [ text $ ms $ _blurb person + , ul_ [] $ seeBook /@ _books person + ] + ] + ] + +seeBook :: Book -> View Action +seeBook book = li_ [] + [ a_ [ class_ "text-dark" + , href_ $ "https://www.amazon.com/dp/" <> (ms $ _amznref book) + ] + [ text $ ms $ _title book ] + ] diff --git a/com/influencedbybooks/default.nix b/com/influencedbybooks/default.nix new file mode 100644 index 0000000..f2ff1ec --- /dev/null +++ b/com/influencedbybooks/default.nix @@ -0,0 +1,32 @@ +# TODO: translate this back to regular nix? +{ + name = "ibb"; + deps = { + both = [ + "clay" + "miso" + "protolude" + "servant" + "text" + ]; + apex = [ + "MonadRandom" + "acid-state" + "blaze-html" + "blaze-markup" + "bytestring" + "githash" + "ixset" + "random" + "safecopy" + "scotty" + "servant-server" + "text" + ]; + aero = [ + "aeson" + "containers" + "ghcjs-base" + ]; + }; +} diff --git a/com/influencedbybooks/influencers.hs b/com/influencedbybooks/influencers.hs new file mode 100644 index 0000000..2583770 --- /dev/null +++ b/com/influencedbybooks/influencers.hs @@ -0,0 +1,407 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Com.InfluencedByBooks.Influencers where + +import Com.InfluencedByBooks.Core + +allPeople :: [Person] +allPeople = + [ Person { _name = "Joe Rogan" + , _pic = "https://pbs.twimg.com/profile_images/552307347851210752/vrXDcTFC_400x400.jpeg" + , _twitter = "joerogan" + , _blurb = "Stand up comic/mixed martial arts fanatic/psychedelic adventurer Host of The Joe Rogan Experience" + , _website = "http://joerogan.com" + , _books = [ Book {_title = "Food of the Gods" + , _author = "Terence McKenna" + , _amznref = "0553371304" + } + , Book { _title = "The War of Art" + , _author ="Steven Pressfield" + , _amznref ="B007A4SDCG" + } + ] + } + , Person { _name = "Beyoncé" + , _pic = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcTxT84sF19lxdnSiblIXAp-Y4wAigpQn8sZ2GtAerIR_ApiiEJfFQ" + , _twitter = "Beyonce" + , _blurb = "American singer, songwriter, actress, record producer and dancer" + , _website = "http://beyonce.com" + , _books = [ Book { _title = "What Will It Take To Make A Woman President?" + , _author = "Marianne Schnall" + , _amznref = "B00E257Y7G"} + ] + } + , Person { _name = "Barrack Obama" + , _pic = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcQeLzftR36p0hYI-EKNa5fm7CYDuN-vyz23_R48ocqa8X1nPr6C" + , _twitter = "BarackObama" + , _blurb = "Dad, husband, President, citizen. 44th POTUS" + , _website = "http://barackobama.com" + , _books = [ Book { _title = "An American Marriage" + , _author = "Tayari Jones" + , _amznref = "B01NCUXEFR"} + , Book { _title = "Americanah" + , _author = "Chimamanda Ngozi Adichie" + , _amznref = "B00A9ET4MC"} + ] + } + , Person { _name = "Warren Buffet" + , _pic = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcQQbmnUykS6zqgzaf44tsq1RAsnHe6H7fapEoSqUwAoJGSFKbAPSw" + , _twitter = "WarrenBuffett" + , _blurb = "Chairman and CEO of Berkshire Hathaway" + , _website = "http://berkshirehathaway.com" + , _books = [ Book { _title = "The Intelligent Investor" + , _author = "Benjamin Graham" + , _amznref = "B000FC12C8"} + , Book { _title = "Security Analysis" + , _author = "Benjamin Graham" + , _amznref = "B0037JO5J8"} + ] + } + , Person { _name = "Bill Gates" + , _pic = "https://pbs.twimg.com/profile_images/988775660163252226/XpgonN0X_400x400.jpg" + , _twitter = "BillGates" + , _blurb = "Sharing things I'm learning through my foundation work and other interests. Founder of Microsoft and Bill & Melinda Gates Foundation" + , _website = "https://www.gatesnotes.com" + , _books = [ Book { _title = "Leonardo da Vinci" + , _author = "Walter Isaacson" + , _amznref = "1501139169" + } + , Book { _title = "Educated" + , _author = "Tara Wetsover" + , _amznref = "B072BLVM83" + } + ] + } + , Person { _name = "Stephen King" + , _pic = "https://pbs.twimg.com/profile_images/378800000836981162/b683f7509ec792c3e481ead332940cdc_400x400.jpeg" + , _twitter = "StephenKing" + , _blurb = "World renowned Author" + , _website = "https://stephenking.com/" + , _books = [ Book { _title = "Red Moon" + , _author = "Benjamin Percy" + , _amznref = "B008TU2592" + } + , Book { _title = "The Marauders" + , _author = "Tom Cooper" + , _amznref = "B00MKZBVTM" + } + ] + } + , Person { _name = "Tobi Lütke" + , _pic = "https://pbs.twimg.com/profile_images/551403375141457920/28EOlhnM_400x400.jpeg" + , _twitter = "tobi" + , _blurb = "Shopify CEO by day, Dad in the evening, hacker at night. - Rails Core alumni; Author of ActiveMerchant, Liquid. Comprehensivist" + , _website = "https://www.shopify.com" + , _books = [ Book { _title = "Influence" + , _author ="Robert B. Cialdini" + , _amznref = "006124189X" + } + , Book { _title = "High Output Management" + , _author ="Andrew S. Grove" + , _amznref = "B015VACHOK" + } + ] + } + , Person { _name = "Susan Cain" + , _pic = "https://pbs.twimg.com/profile_images/1474290079/SusanCain5smaller-1_400x400.jpg" + , _twitter = "susancain" + , _blurb = "Bestselling author, award-winning speaker, http://Quietrev.com curator. Lover of bittersweet music & bittersweet chocolate, in equal measure." + , _website = "https://www.quietrev.com" + , _books = [ Book { _title = "Bird by Bird" + , _author ="Anne Lamott" + , _amznref = "0385480016" + } + , Book { _title = "Waking Up" + , _author ="Sam Harris" + , _amznref = "1451636024" + } + ] + } + , Person { _name = "Oprah Winfrey" + , _pic = "https://pbs.twimg.com/profile_images/1013835283698049025/q5ZN4yv3_400x400.jpg" + , _twitter = "Oprah" + , _blurb = "Oprah Winfrey is an American media executive, actress, talk show host, television producer and philanthropis" + , _website = "http://www.oprah.com/index.html" + , _books = [ Book { _title = "A New Earth" + , _author ="Eckhart Tolle" + , _amznref = "B000PC0S5K" + } + , Book { _title = "The Poisonwood Bible" + , _author ="Barbara Kingsolver" + , _amznref = "B000QTE9WU" + } + ] + } + , Person { _name = "Patrick Collison" + , _pic = "https://pbs.twimg.com/profile_images/825622525342199809/_iAaSUQf_400x400.jpg" + , _twitter = "patrickc" + , _blurb = "Fallibilist, optimist. Stripe CEO" + , _website = "https://patrickcollison.com" + , _books = [ Book { _title = "How Judges Think" + , _author ="Richard A. Posner" + , _amznref = "0674048067" + } + , Book { _title = "Programmers at Work" + , _author ="Susan Lammers" + , _amznref = "1556152116" + } + ] + } + , Person { _name = "Luis Von Ahn" + , _pic = "https://pbs.twimg.com/profile_images/1020343581087678464/NIXD5MdC_400x400.jpg" + , _twitter = "LuisvonAhn" + , _blurb = "CEO & co-founder of duolingo. Invented reCAPTCHA. Computer science professor at Carnegie Mellon. Proud Guatemalan" + , _website = "https://www.duolingo.com/" + , _books = [ Book { _title = "Zero to One" + , _author ="Peter Thiel" + , _amznref = "B00J6YBOFQ" + } + , Book { _title = "The Hard Thing About Hard Things" + , _author ="Ben Horowitz" + , _amznref = "B00DQ845EA" + } + ] + } + , Person { _name = "Bryan Johnson" + , _pic = "https://pbs.twimg.com/profile_images/1055165076372475904/vNp60sSl_400x400.jpg" + , _twitter = "bryan_johnson" + , _blurb = "Founder of Kernel, OS Fund and Braintree. Trying to go where there is no destination" + , _website = "https://bryanjohnson.co" + , _books = [ Book { _title = "A Good Man" + , _author ="Mark Shriver" + , _amznref = "B007CLBH0M" + } + , Book { _title = "Shackleton" + , _author ="Nick Bertozzi" + , _amznref = "1596434511" + } + ] + } + , Person { _name = "Peter Thiel" + , _pic = "https://pbs.twimg.com/profile_images/1121220551/Peter_Thiel_400x400.jpg" + , _twitter = "peterthiel" + , _blurb = "Technology entrepreneur, investor, philanthropist." + , _website = "http://zerotoonebook.com" + , _books = [ Book { _title = "Deceit, Desire, and the Novel" + , _author ="René Girard" + , _amznref = "0801818303" + } + , Book { _title = "Violence and the Sacred" + , _author ="René Girard" + , _amznref = "0801822181" + } + ] + } + , Person { _name = "Tim Ferris" + , _pic = "https://pbs.twimg.com/profile_images/49918572/half-face-ice_400x400.jpg" + , _twitter = "tferriss" + , _blurb = "Author of 5 #1 NYT/WSJ bestsellers, investor (FB, Uber, Twitter, 50+ more: http://angel.co/tim ), host of The Tim Ferriss Show podcast (300M+ downloads)" + , _website = "http://tim.blog" + , _books = [ Book { _title = "10% Happier" + , _author ="Dan Harris" + , _amznref = "0062265431" + } + , Book { _title = "A Guide to the Good Life" + , _author ="William Irvine" + , _amznref = "B0040JHNQG" + } + ] + } + , Person { _name = "Allen Walton" + , _pic = "https://pbs.twimg.com/profile_images/1038905908678545409/yUbF9Ruc_400x400.jpg" + , _twitter = "allenthird" + , _blurb = "Created http://SpyGuy.com and blogs about stuff at http://AllenWalton.com . All things ecommerce, personal dev, and Simpsons." + , _website = "https://www.allenwalton.com" + , _books = [ Book { _title = "4 Hour Work Week" + , _author ="Tim Ferris" + , _amznref = "B002WE46UW" + } + , Book { _title = "Choose Yourself" + , _author ="James Altucher" + , _amznref = "B00CO8D3G4" + } + ] + } + , Person { _name = "Peter Mallouk" + , _pic = "https://pbs.twimg.com/profile_images/713172266968715264/KsyDYghf_400x400.jpg" + , _twitter = "PeterMallouk" + , _blurb = "President of Creative Planning. Author “5 Mistakes Every Investor Makes & How to Avoid Them”. Radically moderate." + , _website = "https://creativeplanning.com" + , _books = [ Book { _title = "Awareness" + , _author ="Anthony de Mello SJ" + , _amznref = "B005GFBP6W" + } + , Book { _title = "The Prophet" + , _author ="Kahlil Gibran" + , _amznref = "B07NDJ3LMW" + } + ] + } + , Person { _name = "Adam Robinson" + , _pic = "https://pbs.twimg.com/profile_images/822708907051077632/y5KyboMV_400x400.jpg" + , _twitter = "IAmAdamRobinson" + , _blurb = "Entrepreneur. Systems builder. Wizard. Shaman of global financial markets. Manifester. Didact. Do-gooder. Alchemist. Aphorist. Seeker. Embracer of possibility." + , _website = "http://robinsonglobalstrategies.com" + , _books = [ Book { _title = "Wishcraft" + , _author ="Barbara Sher" + , _amznref = "0345465180" + } + , Book { _title = "You Can Be a Stock Market Genius" + , _author ="Joel Greenblatt" + , _amznref = "0684832135" + } + ] + } + , Person { _name = "Andrew Weil" + , _pic = "https://pbs.twimg.com/profile_images/987461787422359553/mpoZAmPH_400x400.jpg" + , _twitter = "DrWeil" + , _blurb = "A world-renowned leader and pioneer in the field of integrative medicine, a healing oriented approach to health care which encompasses body, mind, and spirit." + , _website = "https://www.drweil.com" + , _books = [ Book { _title = "The Way Of Life According To Lao Tzu" + , _author = "Witter Byner" + , _amznref = "0399512985" + } + , Book { _title = "The Psychology of Romantic Love" + , _author ="Nathaniel Branden" + , _amznref = "B0012RMVJI" + } + ] + } + , Person { _name = "Hubert Joly" + , _pic = "https://scontent-ort2-2.xx.fbcdn.net/v/t1.0-1/c1.0.193.193a/38444401_2156120597936470_9028564067043770368_n.jpg?_nc_cat=104&_nc_ht=scontent-ort2-2.xx&oh=162142edb167f389a5b585a329e4993a&oe=5CE1D578" + , _twitter = "BBYCEO" + , _blurb = "CEO of Best Buy" + , _website = "https://www.bestbuy.com" + , _books = [ Book { _title = "Who Says Elephants Can't Dance" + , _author = "Louis. V. Gerstner" + , _amznref = "0060523808" + } + , Book { _title = "Onward" + , _author ="Howard Schultz" + , _amznref = "1609613821" + } + ] + } + , Person { _name = "Esther Perel" + , _pic = "https://pbs.twimg.com/profile_images/1091062675151319040/MzxCcgdU_400x400.jpg" + , _twitter = "EstherPerel" + , _blurb = "Exploring modern relationships. Author of MatingInCaptivity and TheStateOfAffairsBook. Podcast: WhereShouldWeBegin. Psychotherapist in NYC." + , _website = "https://www.estherperel.com" + , _books = [ Book { _title = "Crime And Punishment" + , _author = "Fyodor Dostoyevsky" + , _amznref = "B07NL94DFD" + } + , Book { _title = "If This Is a Man and The Truce" + , _author ="Primo Levi" + , _amznref = "0349100136" + } + ] + } + , Person { _name ="Neil deGrasse Tyson" + , _pic = "https://pbs.twimg.com/profile_images/74188698/NeilTysonOriginsA-Crop_400x400.jpg" + , _twitter = "neiltyson" + , _blurb = "Astrophysicistthe. Fifth head since 1935 of the world-renowned Hayden Planetarium in New York City and the first occupant of its Frederick P. Rose Directorship. Research associate of the Department of Astrophysics at the American Museum of Natural History." + , _website = "https://www.haydenplanetarium.org/tyson/" + , _books = [ Book { _title = "The Prince" + , _author = "Machiavelli" + , _amznref = "B07ND3CM16" + } + , Book { _title = "The Art of War" + , _author ="Sun Tzu" + , _amznref = "1545211957" + } + ] + } + , Person { _name = "Mark Cuban" + , _pic = "https://pbs.twimg.com/profile_images/1422637130/mccigartrophy_400x400.jpg" + , _twitter = "mcuban" + , _blurb = "Owner of Dallas Mavericks, Shark on ABC’s Shark Tank, chairman and CEO of AXS tv, and investor in an ever-growing portfolio of businesses" + , _website = "http://markcubancompanies.com/" + , _books = [ Book { _title = "The Fountainhead" + , _author = "Ayn Rend" + , _amznref = "0452273331" + } + , Book { _title = "The Gospel of Wealth " + , _author ="Andrew Carnegie" + , _amznref = "1409942171" + } + ] + } + , Person { _name = "Robert Herjavec" + , _pic = "https://pbs.twimg.com/profile_images/608643660876423170/DgxUW3eZ_400x400.jpg" + , _twitter = "robertherjavec" + , _blurb = "Dad, Husband, Founder & CEO of global cybersecurity firm HerjavecGroup, Shark on ABC’s Shark Tank, Former Dragon, Author" + , _website = "https://www.robertherjavec.com/" + , _books = [ Book { _title = "Why I Run" + , _author = "Mark Sutcliffe" + , _amznref = "B007OC9P3A" + } + , Book { _title = "Swim with the Sharks Without Being Eaten Alive" + , _author ="Harvey B. Mackay" + , _amznref = "006074281X" + } + ] + } + , Person { _name = "Caterina Fake" + , _pic = "https://pbs.twimg.com/profile_images/378800000509318185/d968d62d1bc39f2c82d3fa44db478525_400x400.jpeg" + , _twitter = "Caterina" + , _blurb = "Host, Should this Exist? Investor, Yes VC. Cofounder: Flickr, Hunch, Sesat School. Etsy. Sundance. Homeschooling, film, literature. Dogs." + , _website = "https://caterina.net" + , _books = [ Book { _title = "Growth of the Soil" + , _author = "Knut Hamsun" + , _amznref = "0343181967" + } + , Book { _title = "The Thousand Autumns of Jacob de Zoet" + , _author ="David Mitchell" + , _amznref = "0812976363" + } + ] + } + , Person { _name = "Daymond John" + , _pic = "https://pbs.twimg.com/profile_images/1048022980863954944/eZvGANn0_400x400.jpg" + , _twitter = "TheSharkDaymond" + , _blurb = "CEO of FUBU, Shark on ABC’s Shark Tank, Author." + , _website = "https://daymondjohn.com/" + , _books = [ Book { _title = "Think and Grow Rich" + , _author = "Napoleon Hill" + , _amznref = "1585424331" + } + , Book { _title = "How to Win Friends & Influence People" + , _author ="Dale Carnegie" + , _amznref = "0671027034" + } + ] + } + , Person { _name = "Kevin O'Leary" + , _pic = "https://pbs.twimg.com/profile_images/1067383195597889536/cP6tNEt0_400x400.jpg" + , _twitter = "kevinolearytv" + , _blurb = "Chairman O'Shares ETFs, 4 time Emmy Award winning Shark Tank's Mr. Wonderful, bestselling author, CNBC contributor, wine maker, guitar dude and photographer." + , _website = "http://askmrwonderful.eone.libsynpro.com/" + , _books = [ Book { _title = "Competitive Advantage" + , _author = "Michael Porter" + , _amznref = "0684841460" + } + , Book { _title = "Secrets of Closing the Sale" + , _author ="Zig Ziglar" + , _amznref = "0425081028" + } + ] + } + , Person { _name = "Alex Rodriguez" + , _pic = "https://pbs.twimg.com/profile_images/796405335388848128/LbvsjCA3_400x400.jpg" + , _twitter = "AROD" + , _blurb = "3-time MVP • 14-time All Star • World Series Champ • CEO of @_ARodCorp• @FoxSports Commentator/Analyst • Special Advisor to the Yankees, @ABCSharkTank and ESPN" + , _website = "http://www.arodcorp.com/" + , _books = [ Book { _title = "Blitzscaling" + , _author = "Reid Hoffman" + , _amznref = "1524761419" + } + , Book { _title = "Measure What Matters" + , _author ="John Doerr" + , _amznref = "0525536221" + } + ] + } + ] diff --git a/com/influencedbybooks/keep.hs b/com/influencedbybooks/keep.hs new file mode 100644 index 0000000..0bc527a --- /dev/null +++ b/com/influencedbybooks/keep.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Keep is a database built on Data.Acid. +-- +-- If this proves useful, maybe we could make it a more general thing. Like +-- `Biz.Keep`. I could wrap all the safecopy stuff in my own template haskell +-- like `$(keep ''MyType)`. +-- +module Com.InfluencedByBooks.Keep where + +import Com.InfluencedByBooks.Core (Person(..), Book(..)) +import Control.Monad.State (get, put) +import Control.Monad.Reader (ask) +import Data.Acid (Update, makeAcidic) +import qualified Data.Acid as Acid +import Data.Data (Data, Typeable) +import Data.IxSet (Indexable(..), IxSet, ixFun, ixSet) +import qualified Data.IxSet as IxSet +import Data.SafeCopy +import Data.Text (Text) +import qualified Data.Text as Text + +import qualified Com.InfluencedByBooks.Influencers as Influencers + +-- * Keep + +-- | Main database. Need to think of a better name for this. +data IbbKeep = IbbKeep + { _people :: IxSet Person + } + deriving (Data, Typeable) + +$(deriveSafeCopy 0 'base ''IbbKeep) + +-- * Index @Person@ + +$(deriveSafeCopy 0 'base ''Person) + +newtype PersonName = + PersonName Text deriving (Eq, Ord, Data, Typeable) + +newtype PersonBlurb = + PersonBlurb Text deriving (Eq, Ord, Data, Typeable) + +instance Indexable Person where + empty = ixSet + [ ixFun $ \p -> [ PersonName $ _name p ] + , ixFun $ \p -> [ _pic p ] + , ixFun $ \p -> [ _twitter p ] + , ixFun $ \p -> [ _website p ] + , ixFun $ \p -> [ _books p ] + , ixFun $ \p -> [ PersonBlurb $ _blurb p ] + ] + +-- | updates the `IbbKeep` with a new `Person` +newPerson :: Text -> Text -> Update IbbKeep Person +newPerson name blurb = do + k <- get + put $ k { _people = IxSet.insert p (_people k) + } + return p + where + p = Person + { _name = name + , _pic = Text.empty + , _twitter = Text.empty + , _website = Text.empty + , _books = [] + , _blurb = blurb + } + +getPeople :: Int -> Acid.Query IbbKeep [Person] +getPeople n = do + keep <- ask + return $ take n $ IxSet.toList $ _people keep + +-- * Index @Book@ + +$(deriveSafeCopy 0 'base ''Book) + +newtype BookTitle = + BookTitle Text deriving (Eq, Ord, Data, Typeable) + +newtype BookAuthor = + BookAuthor Text deriving (Eq, Ord, Data, Typeable) + +instance Indexable Book where + empty = ixSet + [ ixFun $ \b -> [ BookTitle $ _title b ] + , ixFun $ \b -> [ BookAuthor $ _author b ] + , ixFun $ \b -> [ _amznref b ] + ] + +-- | updates the `IbbKeep` with a new `Book` +--newBook :: Text -> Text -> Text -> Update IbbKeep Book +--newBook title author amznref = do +-- ibbKeep <- get +-- put $ ibbKeep { _books = IxSet.insert b (_books ibbKeep) +-- , _people = _people ibbKeep +-- } +-- return b +-- where +-- b = Book { _title = title +-- , _author = author +-- , _amznref = amznref +-- } + +-- * Opening the keep + +-- defines @NewPerson@ for us. +$(makeAcidic ''IbbKeep ['newPerson, 'getPeople]) + +initialIbbKeep :: IbbKeep +initialIbbKeep = IbbKeep + { _people = IxSet.fromList Influencers.allPeople + } + +openLocal :: String -> IO (Acid.AcidState IbbKeep) +openLocal dir = + Acid.openLocalStateFrom dir initialIbbKeep diff --git a/com/influencedbybooks/look.hs b/com/influencedbybooks/look.hs new file mode 100644 index 0000000..d61fc11 --- /dev/null +++ b/com/influencedbybooks/look.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | The look and feel of Ibb +module Com.InfluencedByBooks.Look where + +import Com.Simatime.Alpha +import Clay +import qualified Clay.Stylesheet as Stylesheet +import qualified Clay.Render as Clay +import qualified Clay.Flexbox as Flexbox +import qualified Clay.Media as Media + +main :: Css +main = do + "html" <> "body" ? do + width (pc 100) + display flex + flexDirection column + alignItems center + alignContent center + justifyContent center + ".container" ? do + width (px 900) + display flex + justifyContent center + flexDirection column diff --git a/com/influencedbybooks/move.hs b/com/influencedbybooks/move.hs new file mode 100644 index 0000000..2c0ee37 --- /dev/null +++ b/com/influencedbybooks/move.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | App update logic +module Com.InfluencedByBooks.Move ( + move + -- * Server interactions + , fetchPeople + ) where + +import Alpha +import Data.Aeson +import Com.InfluencedByBooks.Core as Core +import JavaScript.Web.XMLHttpRequest (Request(..), Method(GET), RequestData(NoData), contents, xhrByteString) +import Miso +import Miso.String +import Com.Simatime.Network + +move :: Action -> Model -> Effect Action Model +move Nop m = noEff m +move (HandleRoute u) m = m { uri = u } <# pure Nop +move (ChangeRoute u) m = m <# do pushURI u >> pure Nop +move FetchPeople m = m <# (SetPeople /@ fetchPeople) +move (SetPeople ps) m = noEff m { people = ps } + +fetchPeople :: IO (WebData [Core.Person]) +fetchPeople = do + mjson <- contents /@ xhrByteString req + case mjson of + Nothing -> pure $ Failure "could not read from server" + Just a -> pure + $ fromEither + $ either (Left . ms) pure + $ eitherDecodeStrict a + where + req = Request { reqMethod = GET + -- FIXME: can replace this hardcoding with a function? + , reqURI = "/api/people" + , reqLogin = Nothing + , reqHeaders = [] + , reqWithCredentials = False + , reqData = NoData + } diff --git a/com/simatime.nix b/com/simatime.nix new file mode 100644 index 0000000..e26219a --- /dev/null +++ b/com/simatime.nix @@ -0,0 +1,60 @@ +{ nixos }: + +/* + +com.simatime - cloud infrastructure server. + +This serves the git repo, mailserver, znc bouncer, user sites, and so on. + +Currently also used as a catch-all production/staging server, until I get real +stuff deployed. + +*/ + +{ + service = + let + nixos-mailserver = builtins.fetchTarball { + url = "https://gitlab.com/simple-nixos-mailserver/nixos-mailserver/-/archive/v2.2.1/nixos-mailserver-v2.2.1.tar.gz"; + sha256 = "03d49v8qnid9g9rha0wg2z6vic06mhp0b049s3whccn1axvs2zzx"; + }; + in nixos { + system = "x86_64-linux"; + configuration = { + imports = [ + ./simatime/hardware.nix + ./simatime/networking.nix + + # common infra + ./simatime/users.nix + ./simatime/packages.nix + + # configured modules + ./simatime/git.nix + ./simatime/mail.nix + ./simatime/web.nix + ./simatime/znc.nix + + # third party + nixos-mailserver + ]; + + nixpkgs.config.allowUnfree = true; + + programs.mosh = { + enable = true; + withUtempter = true; + }; + + services.openssh = { + enable = true; + passwordAuthentication = false; + }; + + security.sudo.wheelNeedsPassword = true; + boot.cleanTmpDir = true; + }; + }; + + dev = import ./simatime/dev.nix { inherit nixos; }; +} diff --git a/com/simatime/alpha.hs b/com/simatime/alpha.hs new file mode 100644 index 0000000..438b97a --- /dev/null +++ b/com/simatime/alpha.hs @@ -0,0 +1,24 @@ +{-# 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 new file mode 100644 index 0000000..11403e8 --- /dev/null +++ b/com/simatime/bild.scm @@ -0,0 +1,145 @@ +;; bild - a simple build tool +;; +;;; 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] +;; +;; 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 +;; +;; 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 +;; +;; 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 -i -o -main-is .main +;; +;; Some definitions: +;; +;; - is some source file +;; - is the stack of dependencies +;; - is the target namespace, indicated by 'bild ' +;; +;; 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 file corresponding to +;; 3. Look for 'import ', where is a namespace in the +;; aforementioned cache. +;; 4. If found, then save current build as a continuation and compile +;; . Result gets put on the dependency stack +;; 5. When finished, return to building +;; +;; Once the build command template is filled out, we can create the nix expression. +;; +;; TODO +;; +;; 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 +;; - the top of the file should +;; +;;; Code: + +(define-module (com simatime bild) + #:use-module ((ice-9 ftw) #:prefix ftw:) + #:export (ns? + ns->path)) + +(define ns? symbol?) + +(define (ns->path ns) + ;; in place of a spec + (when (ns? ns) + (string-fold + (lambda (a b) + (if (eq? a #\.) + (string-concatenate (list b (string #\/))) + (string-concatenate (list b (string a))))) + "" + (symbol->string ns)))) + +(define ns->module-name (ns) + TODO) + +(define (ns sym) + (define-module (ns->module-name))) + +(define (prn a) (display a) (newline)) + +;; todo +;; +;; - find buildable files given a namespace +;; - select a build method based on ext +;; - run the build +(define (find-buildable ns) + (ftw:ftw ns + (lambda (a b c) + (map prn (list a b c)) + #t))) diff --git a/com/simatime/core.scm b/com/simatime/core.scm new file mode 100644 index 0000000..6a4f09d --- /dev/null +++ b/com/simatime/core.scm @@ -0,0 +1,73 @@ +(define-module (com simatime core)) + +;; +;; old core, do i still need this? +;; + +(define (not x) (if x #f #t)) +(define (null? obj) (if (eqv? obj '()) #t #f)) +(define (list objs) objs) +(define (identity obj) obj) +(define (flip f) (lambda (x y) (f y x))) +(define (curry f a) (lambda (b) (apply f (cons a (list b))))) +(define (compose f g) (lambda (x) (f (apply g x)))) +(define zero? (curry = 0)) +(define positive? (curry < 0)) +(define negative? (curry > 0)) +(define (odd? n) (= (mod n 2) 1)) +(define (even? n) (= (mod n 2) 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 (mem* pred op) + (lambda (acc next) + (if (and (not acc) (pred (op next))) + next + acc))) + +(define (sum lst) (fold + 0 lst)) +(define (produce lst) (fold * 0 1 lst)) + +(define (max nums) + (fold (lambda (x y) (if (> x y) x y)) + (car nums) (cdr nums))) + +(define (min nums) + (fold (lambda (x y) (if (< x y) x y)) + (car nums) (cdr nums))) + +(define (length lst) (fold (lambda (x y) (+ x 1)) 0 lst)) +(define (reverse lst) (fold (flip cons) '() lst)) +(define (memq obj lst) (fold (mem* (curry eq? obj) identity) #f lst)) +(define (memv obj lst) (fold (mem* (curry eqv? obj) identity) #f lst)) +(define (member obj lst) (fold (mem* (curry equal? obj) identity) #f lst)) +(define (assq obj alist) (fold (mem* (curry eq? obj) car) #f alist)) +(define (assv obj alist) (fold (mem* (curry eqv? obj) car) #f alist)) +(define (assoc obj alist) (fold (mem* (curry equal? obj) car) #f alist)) +(define (map f lst) (foldr (lambda (x y) (cons (f x) y)) '() lst)) +(define (filter pred lst) (foldr (lambda (x y) (if (pred x) (cons x y) y)) '() lst)) + + +;; +;; clojure-like stuff +;; + +(define (pr . a) + (for-each display args)) + +(define (prn . a) (apply pr a) (newline)) diff --git a/com/simatime/dev.nix b/com/simatime/dev.nix new file mode 100644 index 0000000..a45a92b --- /dev/null +++ b/com/simatime/dev.nix @@ -0,0 +1,20 @@ +{ nixos }: + +/* + +com.simatime.dev - main development/build server. Lives in ben's apartment in +Mountain View. + +*/ + +nixos { + system = "x86_64-linux"; + configuration = { + imports = [ + ./users.nix + ./packages.nix + ./dev/hardware.nix + ./dev/configuration.nix + ]; + }; +} diff --git a/com/simatime/dev/configuration.nix b/com/simatime/dev/configuration.nix new file mode 100644 index 0000000..b313a36 --- /dev/null +++ b/com/simatime/dev/configuration.nix @@ -0,0 +1,215 @@ +{ 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 + ]; + 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"; + }; + }; + }; + + emby = { + enable = true; + user = "emby"; + }; + + 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 new file mode 100644 index 0000000..fc0e7a0 --- /dev/null +++ b/com/simatime/dev/hardware.nix @@ -0,0 +1,34 @@ +# 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 = + [ + ]; + + 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 new file mode 100644 index 0000000..40e8b0b --- /dev/null +++ b/com/simatime/fathom.nix @@ -0,0 +1,109 @@ +{ 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 new file mode 100644 index 0000000..12316fb --- /dev/null +++ b/com/simatime/firefox.nix @@ -0,0 +1,12 @@ +{ ... }: + +{ + 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 new file mode 100644 index 0000000..51e46b6 --- /dev/null +++ b/com/simatime/git.nix @@ -0,0 +1,18 @@ +{ 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 new file mode 100644 index 0000000..1b32230 --- /dev/null +++ b/com/simatime/go.hs @@ -0,0 +1,100 @@ +-- 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 new file mode 100644 index 0000000..8c88cb7 --- /dev/null +++ b/com/simatime/hardware.nix @@ -0,0 +1,6 @@ +{ ... }: +{ + imports = [ ]; + 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 new file mode 100644 index 0000000..d4d9d6f --- /dev/null +++ b/com/simatime/idea/duree-pitch.org @@ -0,0 +1,80 @@ +#+TITLE: Duree: automated universal database +#+SUBTITLE: seeking pre-seed funding +#+AUTHOR: Ben Sima +#+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 new file mode 100644 index 0000000..1c392f0 --- /dev/null +++ b/com/simatime/idea/flash.org @@ -0,0 +1,36 @@ +#+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 new file mode 100644 index 0000000..c661508 --- /dev/null +++ b/com/simatime/keys/ben.pub @@ -0,0 +1 @@ +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 new file mode 100644 index 0000000..664a2d9 --- /dev/null +++ b/com/simatime/keys/deploy.pub @@ -0,0 +1 @@ +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 new file mode 100644 index 0000000..4dc08fb --- /dev/null +++ b/com/simatime/keys/nick.pub @@ -0,0 +1 @@ +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 new file mode 100644 index 0000000..a810706 --- /dev/null +++ b/com/simatime/language/bs.hs @@ -0,0 +1,12 @@ +-- 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 new file mode 100644 index 0000000..4c48c86 --- /dev/null +++ b/com/simatime/language/bs/cli.hs @@ -0,0 +1,52 @@ +{-# 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 new file mode 100644 index 0000000..290170b --- /dev/null +++ b/com/simatime/language/bs/eval.hs @@ -0,0 +1,241 @@ +{-# 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 )" + +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 )" + + +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 )" + + +-- 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 new file mode 100644 index 0000000..a39c7b6 --- /dev/null +++ b/com/simatime/language/bs/expr.hs @@ -0,0 +1,154 @@ +{-# 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 "" + + Func _ _ -> + textStrict "" + + 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 new file mode 100644 index 0000000..3044a60 --- /dev/null +++ b/com/simatime/language/bs/parser.hs @@ -0,0 +1,121 @@ +{-# 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) "" + +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 new file mode 100644 index 0000000..c074c59 --- /dev/null +++ b/com/simatime/language/bs/primitives.hs @@ -0,0 +1,183 @@ +{-# 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 new file mode 100644 index 0000000..64ffaa2 --- /dev/null +++ b/com/simatime/language/bs/repl.hs @@ -0,0 +1,33 @@ +{-# 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 new file mode 100644 index 0000000..4a40036 --- /dev/null +++ b/com/simatime/language/bs/test.hs @@ -0,0 +1,2 @@ +-- TODO +module Language.Bs.Test where diff --git a/com/simatime/mail.nix b/com/simatime/mail.nix new file mode 100644 index 0000000..81bddc2 --- /dev/null +++ b/com/simatime/mail.nix @@ -0,0 +1,43 @@ +{ ... }: + +{ + 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 new file mode 100644 index 0000000..e47e891 --- /dev/null +++ b/com/simatime/network.hs @@ -0,0 +1,31 @@ +-- | A port of Kris Jenkins' RemoteData Elm module +-- . +-- +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 new file mode 100644 index 0000000..4cfd73d --- /dev/null +++ b/com/simatime/networking.nix @@ -0,0 +1,38 @@ +{ lib, ... }: { + 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 new file mode 100644 index 0000000..5d8dc56 --- /dev/null +++ b/com/simatime/nixpkgs.nix @@ -0,0 +1,5 @@ +# 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 new file mode 100644 index 0000000..2c522f6 --- /dev/null +++ b/com/simatime/packages.nix @@ -0,0 +1,11 @@ +{ pkgs, ... }: + +{ + environment.systemPackages = [ + pkgs.wget + pkgs.ranger + pkgs.vnstat + pkgs.gitAndTools.gitFull + pkgs.python3 + ]; +} diff --git a/com/simatime/repl.scm b/com/simatime/repl.scm new file mode 100644 index 0000000..3d2f6d9 --- /dev/null +++ b/com/simatime/repl.scm @@ -0,0 +1,34 @@ +(define-module (com simatime repl) + #:use-module ((ice-9 ftw) #:prefix ftw:) + #:export (pr prn pwd ls cd)) + + +;; +;; shell-like stuff +;; +(use-modules ((ice-9 ftw) #:prefix ftw:)) + +(define (pwd) + (regexp-substitute/global + #f "/home/ben" (getcwd) 'pre "~" 'post)) + +(define (ls) + (ftw:scandir (getcwd))) + +(define (cd path) + (chdir path) + (ls)) + + +;; +;; 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)))) diff --git a/com/simatime/sema.hs b/com/simatime/sema.hs new file mode 100644 index 0000000..f0f75da --- /dev/null +++ b/com/simatime/sema.hs @@ -0,0 +1,12 @@ +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/shuffle.hs b/com/simatime/shuffle.hs new file mode 100644 index 0000000..02cd3e0 --- /dev/null +++ b/com/simatime/shuffle.hs @@ -0,0 +1,122 @@ +{- | +Module : System.Random.Shuffle +Copyright : (c) 2009 Oleg Kiselyov, Manlio Perillo +License : BSD3 (see LICENSE file) + + + + +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/users.nix b/com/simatime/users.nix new file mode 100644 index 0000000..daac9d6 --- /dev/null +++ b/com/simatime/users.nix @@ -0,0 +1,33 @@ +{ ... }: + +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 new file mode 100644 index 0000000..d6be348 --- /dev/null +++ b/com/simatime/web.nix @@ -0,0 +1,41 @@ +{ ... }: + +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 new file mode 100644 index 0000000..bdbe3af --- /dev/null +++ b/com/simatime/znc.nix @@ -0,0 +1,70 @@ +/* + +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" ]; + }; + Network.sorcery = { + Server = "irc.sorcery.net +6697"; + LoadModule = [ "simple_away" ]; + }; + Pass.password = { + Method = "sha256"; + Hash = "bead16d806e7bf5cbbc31d572b20f01e2b253eb60e2497ce465df56306becd02"; + Salt = "/GhmBMc+E6b7qd8muFEe"; + }; + }; + }; + }; + }; +} diff --git a/default.nix b/default.nix index b894aa2..55f96e7 100644 --- a/default.nix +++ b/default.nix @@ -1,9 +1,59 @@ let - nixpkgs-tar = builtins.fetchTarball (import ./pack/nixpkgs.nix); + nixpkgs-tar = builtins.fetchTarball (import ./nixpkgs.nix); nixpkgs = import "${nixpkgs-tar}" {}; nixos = import "${nixpkgs-tar}/nixos"; -in -{ - depo = import ./depo { inherit nixos; }; - pack = import ./pack { inherit nixpkgs; }; + + # a common build function + # + bild = file: + with nixpkgs; + let + pack = import file; + + depsToPackageSet = packageSet: deps: + map (s: builtins.getAttr s packageSet) deps; + + ghc844_ = pkgs.haskell.packages.ghc844.override (oldAttrs: { + overrides = with pkgs.haskell.lib; self: super: { + clay = dontCheck super.clay; + }; + }); + + ghc = ghc844_.ghcWithPackages (hp: depsToPackageSet hp + # we need hinotify for chip/make + ([ "hinotify" ] ++ pack.deps.both ++ pack.deps.apex)); + + 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 (pack.deps.both ++ pack.deps.aero)); + + make = ./chip/make; + in stdenv.mkDerivation { + name = pack.name; + version = "0"; + src = ../.; + nativeBuildInputs = [ + ghc ghcjs + ]; + strictDeps = true; + buildPhase = "${ghc}/bin/runhaskell ${make} ${pack.name}"; + installPhase = '' + mkdir -p $out/bin + cp bild/${pack.name} $out/bin/${pack.name} + ''; + }; +in { + com.simatime = import ./com/simatime.nix { inherit nixos; }; + com.influencedbybooks = import ./com/influencedbybooks/default.nix {}; } diff --git a/depo/default.nix b/depo/default.nix deleted file mode 100644 index e2c5d6a..0000000 --- a/depo/default.nix +++ /dev/null @@ -1,6 +0,0 @@ -{ nixos }: - -{ - nutin-madaj = import ./nutin-madaj { inherit nixos; }; - hikuj-zupip = import ./hikuj-zupip { inherit nixos; }; -} diff --git a/depo/hikuj-zupip/configuration.nix b/depo/hikuj-zupip/configuration.nix deleted file mode 100644 index b313a36..0000000 --- a/depo/hikuj-zupip/configuration.nix +++ /dev/null @@ -1,215 +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 - ]; - 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"; - }; - }; - }; - - emby = { - enable = true; - user = "emby"; - }; - - 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/depo/hikuj-zupip/default.nix b/depo/hikuj-zupip/default.nix deleted file mode 100644 index 31de11f..0000000 --- a/depo/hikuj-zupip/default.nix +++ /dev/null @@ -1,23 +0,0 @@ -{ nixos }: - -/* - -hidor-kahih - main development/build server. Lives in ben's living room. - -*/ - -nixos { - system = "x86_64-linux"; - configuration = { - nixpkgs.overlays = [ - (import ../../pack/overlay.nix) - ]; - - imports = [ - ./hardware.nix - ../users.nix - ../packages.nix - ./configuration.nix - ]; - }; -} diff --git a/depo/hikuj-zupip/hardware.nix b/depo/hikuj-zupip/hardware.nix deleted file mode 100644 index fc0e7a0..0000000 --- a/depo/hikuj-zupip/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 = - [ - ]; - - 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/depo/nutin-madaj/default.nix b/depo/nutin-madaj/default.nix deleted file mode 100644 index 4d9dd02..0000000 --- a/depo/nutin-madaj/default.nix +++ /dev/null @@ -1,94 +0,0 @@ -{ nixos }: - -/* - -nutin-madaj - cloud infrastructure server. - -This serves the git repo, mailserver, znc bouncer, user sites, and so on. - -Currently also used as a catch-all production/staging server, until I get real -stuff deployed. - -*/ - -let - nixos-mailserver = builtins.fetchTarball { - url = "https://gitlab.com/simple-nixos-mailserver/nixos-mailserver/-/archive/v2.2.1/nixos-mailserver-v2.2.1.tar.gz"; - sha256 = "03d49v8qnid9g9rha0wg2z6vic06mhp0b049s3whccn1axvs2zzx"; - }; - ibbPort = "3000"; - fathomPort = "3030"; -in -nixos { - system = "x86_64-linux"; - configuration = { - imports = [ - ./hardware-configuration.nix - ./networking.nix - - # common infra - ../users.nix - ../packages.nix - - # configured modules - ./git.nix - ./mail.nix - ./web.nix - ./znc.nix - - # our custom modules - #../../mode/ibb.nix - #../../mode/fathom.nix - - # third party - nixos-mailserver - ]; - - nixpkgs.config.allowUnfree = true; - nixpkgs.overlays = [ - (import ../../pack/overlay.nix) - ]; - - programs.mosh = { - enable = true; - withUtempter = true; - }; - - services.openssh = { - enable = true; - passwordAuthentication = false; - }; - - security.sudo.wheelNeedsPassword = true; - - # our custom apps - #services = { - # ibb = { - # enable = false; - # port = ibbPort; - # }; - # # TODO: move this nginx config into mode/ibb.nix - # nginx.virtualHosts."influencedbybooks.com" = { - # forceSSL = true; - # enableACME = true; - # locations = { - # "/" = { - # proxyPass = "http://localhost:${ibbPort}"; - # }; - # }; - # }; - # fathom = { - # enable = true; - # port = fathomPort; - # dataDir = "/var/lib/fathom"; - # }; - # nginx.virtualHosts."stats.simatime.com" = { - # locations."/".proxyPass = "http://localhost:${fathomPort}"; - # forceSSL = true; - # enableACME = true; - # }; - #}; - - boot.cleanTmpDir = true; - }; -} diff --git a/depo/nutin-madaj/firefox.nix b/depo/nutin-madaj/firefox.nix deleted file mode 100644 index 12316fb..0000000 --- a/depo/nutin-madaj/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/depo/nutin-madaj/git.nix b/depo/nutin-madaj/git.nix deleted file mode 100644 index e61abb4..0000000 --- a/depo/nutin-madaj/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/depo/nutin-madaj/hardware-configuration.nix b/depo/nutin-madaj/hardware-configuration.nix deleted file mode 100644 index 8c88cb7..0000000 --- a/depo/nutin-madaj/hardware-configuration.nix +++ /dev/null @@ -1,6 +0,0 @@ -{ ... }: -{ - imports = [ ]; - boot.loader.grub.device = "/dev/vda"; - fileSystems."/" = { device = "/dev/vda1"; fsType = "ext4"; }; -} diff --git a/depo/nutin-madaj/mail.nix b/depo/nutin-madaj/mail.nix deleted file mode 100644 index 81bddc2..0000000 --- a/depo/nutin-madaj/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/depo/nutin-madaj/networking.nix b/depo/nutin-madaj/networking.nix deleted file mode 100644 index 4cfd73d..0000000 --- a/depo/nutin-madaj/networking.nix +++ /dev/null @@ -1,38 +0,0 @@ -{ lib, ... }: { - 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/depo/nutin-madaj/web.nix b/depo/nutin-madaj/web.nix deleted file mode 100644 index d6be348..0000000 --- a/depo/nutin-madaj/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/depo/nutin-madaj/znc.nix b/depo/nutin-madaj/znc.nix deleted file mode 100644 index 0449893..0000000 --- a/depo/nutin-madaj/znc.nix +++ /dev/null @@ -1,70 +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" ]; - }; - Network.sorcery = { - Server = "irc.sorcery.net +6697"; - LoadModule = [ "simple_away" ]; - }; - Pass.password = { - Method = "sha256"; - Hash = "bead16d806e7bf5cbbc31d572b20f01e2b253eb60e2497ce465df56306becd02"; - Salt = "/GhmBMc+E6b7qd8muFEe"; - }; - }; - }; - }; - }; -} diff --git a/depo/packages.nix b/depo/packages.nix deleted file mode 100644 index 2c522f6..0000000 --- a/depo/packages.nix +++ /dev/null @@ -1,11 +0,0 @@ -{ pkgs, ... }: - -{ - environment.systemPackages = [ - pkgs.wget - pkgs.ranger - pkgs.vnstat - pkgs.gitAndTools.gitFull - pkgs.python3 - ]; -} diff --git a/depo/users.nix b/depo/users.nix deleted file mode 100644 index cd73996..0000000 --- a/depo/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/idea/duree-pitch.org b/idea/duree-pitch.org deleted file mode 100644 index d4d9d6f..0000000 --- a/idea/duree-pitch.org +++ /dev/null @@ -1,80 +0,0 @@ -#+TITLE: Duree: automated universal database -#+SUBTITLE: seeking pre-seed funding -#+AUTHOR: Ben Sima -#+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/idea/flash.org b/idea/flash.org deleted file mode 100644 index 1c392f0..0000000 --- a/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/keys/ben.pub b/keys/ben.pub deleted file mode 100644 index c661508..0000000 --- a/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/keys/deploy.pub b/keys/deploy.pub deleted file mode 100644 index 664a2d9..0000000 --- a/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/keys/nick.pub b/keys/nick.pub deleted file mode 100644 index 4dc08fb..0000000 --- a/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/lore/Alpha.hs b/lore/Alpha.hs deleted file mode 100644 index bae7fa5..0000000 --- a/lore/Alpha.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} --- | Commonly useful functions, a Prelude replacement. -module 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/lore/Biz/Ibb.hs b/lore/Biz/Ibb.hs deleted file mode 100644 index dd99654..0000000 --- a/lore/Biz/Ibb.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | Main app logic -module Biz.Ibb ( - module X - ) where - -import Biz.Ibb.Core as X -import Biz.Ibb.Influencers as X diff --git a/lore/Biz/Ibb/Core.hs b/lore/Biz/Ibb/Core.hs deleted file mode 100644 index ff00060..0000000 --- a/lore/Biz/Ibb/Core.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Main app logic -module Biz.Ibb.Core where - -import Alpha -import Data.Aeson hiding (Success) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import GHC.Generics (Generic) -import Miso -import Miso.String -import Network.RemoteData -import Servant.API -import Servant.Links - --- * entity data types - -data Person = Person - { _name :: Text - -- ^ Their full name. - , _pic :: Text - -- ^ A link to their picture. - , _twitter :: Text - -- ^ Their twitter handle, without the `@` prefix. - , _website :: Text - -- ^ Their main website, fully formed: `https://example.com` - , _books :: [Book] - -- ^ A short list of the books they recommend. - , _blurb :: Text - -- ^ A short "about" section, like you would see on the jacket flap of a book. - } deriving (Generic, Show, Eq, Typeable, Data, Ord) - -instance FromJSON Person -instance ToJSON Person - -data Book = Book - { _title :: Text - , _author :: Text - , _amznref :: Text - -- ^ Amazon REF number, for creating affiliate links. - } deriving (Generic, Show, Eq, Typeable, Data, Ord) - -instance FromJSON Book -instance ToJSON Book - --- * app data types - -type AppRoutes = Home - -type Home = View Action - -data Model = Model - { uri :: URI - , people :: WebData [Person] - } deriving (Show, Eq) - -type WebData a = RemoteData MisoString a - -init :: URI -> Model -init u = Model u Loading - -data Action - = Nop - | ChangeRoute URI - | HandleRoute URI - | FetchPeople - | SetPeople (WebData [Person]) - deriving (Show, Eq) - -home :: Model -> View Action -home m = see m - -handlers :: Model -> View Action -handlers = home - -notfound :: View Action -notfound = div_ [] [ text "404" ] - -goHome :: URI -goHome = linkURI $ safeLink - (Proxy :: Proxy AppRoutes) - (Proxy :: Proxy Home) - -see :: Model -> View Action -see m = div_ [ class_ "container mt-5" ] - [ div_ [ class_ "jumbotron" ] - [ h1_ [ class_ "display-4" ] [ text "Influenced by books" ] - , p_ [ class_ "lead" ] [ text "Influential people and the books that made them." ] - , p_ [ class_ "lead" ] - [ a_ [ href_ "http://eepurl.com/ghBFjv" ] - [ text "Get new book recommendations from the world's influencers in your email." ] - ] - ] - , div_ [ class_ "card-columns" ] $ case people m of - NotAsked -> [ text "Initializing..." ] - Loading -> [ text "Loading..." ] - Failure err -> [ text err ] - Success ps -> seePerson /@ ps - ] - -seePerson :: Person -> View Action -seePerson person = div_ [ class_ "card" ] - [ div_ [ class_ "card-img" ] - [ img_ [ class_ "card-img img-fluid", src_ $ ms $ _pic person ]] - , div_ [ class_ "card-body" ] - [ h4_ [ class_ "card-title" ] [ text $ ms $ _name person ] - , h6_ [] [ a_ [ class_ "fab fa-twitter" - , href_ $ "https://twitter.com/" <> (ms $ _twitter person) ] [] - , a_ [ class_ "fas fa-globe", href_ $ ms $ _website person ] [] - ] - , p_ [ class_ "card-text" ] - [ text $ ms $ _blurb person - , ul_ [] $ seeBook /@ _books person - ] - ] - ] - -seeBook :: Book -> View Action -seeBook book = li_ [] - [ a_ [ class_ "text-dark" - , href_ $ "https://www.amazon.com/dp/" <> (ms $ _amznref book) - ] - [ text $ ms $ _title book ] - ] diff --git a/lore/Biz/Ibb/Influencers.hs b/lore/Biz/Ibb/Influencers.hs deleted file mode 100644 index c31e962..0000000 --- a/lore/Biz/Ibb/Influencers.hs +++ /dev/null @@ -1,407 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveDataTypeable #-} - -module Biz.Ibb.Influencers where - -import Biz.Ibb.Core - -allPeople :: [Person] -allPeople = - [ Person { _name = "Joe Rogan" - , _pic = "https://pbs.twimg.com/profile_images/552307347851210752/vrXDcTFC_400x400.jpeg" - , _twitter = "joerogan" - , _blurb = "Stand up comic/mixed martial arts fanatic/psychedelic adventurer Host of The Joe Rogan Experience" - , _website = "http://joerogan.com" - , _books = [ Book {_title = "Food of the Gods" - , _author = "Terence McKenna" - , _amznref = "0553371304" - } - , Book { _title = "The War of Art" - , _author ="Steven Pressfield" - , _amznref ="B007A4SDCG" - } - ] - } - , Person { _name = "Beyoncé" - , _pic = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcTxT84sF19lxdnSiblIXAp-Y4wAigpQn8sZ2GtAerIR_ApiiEJfFQ" - , _twitter = "Beyonce" - , _blurb = "American singer, songwriter, actress, record producer and dancer" - , _website = "http://beyonce.com" - , _books = [ Book { _title = "What Will It Take To Make A Woman President?" - , _author = "Marianne Schnall" - , _amznref = "B00E257Y7G"} - ] - } - , Person { _name = "Barrack Obama" - , _pic = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcQeLzftR36p0hYI-EKNa5fm7CYDuN-vyz23_R48ocqa8X1nPr6C" - , _twitter = "BarackObama" - , _blurb = "Dad, husband, President, citizen. 44th POTUS" - , _website = "http://barackobama.com" - , _books = [ Book { _title = "An American Marriage" - , _author = "Tayari Jones" - , _amznref = "B01NCUXEFR"} - , Book { _title = "Americanah" - , _author = "Chimamanda Ngozi Adichie" - , _amznref = "B00A9ET4MC"} - ] - } - , Person { _name = "Warren Buffet" - , _pic = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcQQbmnUykS6zqgzaf44tsq1RAsnHe6H7fapEoSqUwAoJGSFKbAPSw" - , _twitter = "WarrenBuffett" - , _blurb = "Chairman and CEO of Berkshire Hathaway" - , _website = "http://berkshirehathaway.com" - , _books = [ Book { _title = "The Intelligent Investor" - , _author = "Benjamin Graham" - , _amznref = "B000FC12C8"} - , Book { _title = "Security Analysis" - , _author = "Benjamin Graham" - , _amznref = "B0037JO5J8"} - ] - } - , Person { _name = "Bill Gates" - , _pic = "https://pbs.twimg.com/profile_images/988775660163252226/XpgonN0X_400x400.jpg" - , _twitter = "BillGates" - , _blurb = "Sharing things I'm learning through my foundation work and other interests. Founder of Microsoft and Bill & Melinda Gates Foundation" - , _website = "https://www.gatesnotes.com" - , _books = [ Book { _title = "Leonardo da Vinci" - , _author = "Walter Isaacson" - , _amznref = "1501139169" - } - , Book { _title = "Educated" - , _author = "Tara Wetsover" - , _amznref = "B072BLVM83" - } - ] - } - , Person { _name = "Stephen King" - , _pic = "https://pbs.twimg.com/profile_images/378800000836981162/b683f7509ec792c3e481ead332940cdc_400x400.jpeg" - , _twitter = "StephenKing" - , _blurb = "World renowned Author" - , _website = "https://stephenking.com/" - , _books = [ Book { _title = "Red Moon" - , _author = "Benjamin Percy" - , _amznref = "B008TU2592" - } - , Book { _title = "The Marauders" - , _author = "Tom Cooper" - , _amznref = "B00MKZBVTM" - } - ] - } - , Person { _name = "Tobi Lütke" - , _pic = "https://pbs.twimg.com/profile_images/551403375141457920/28EOlhnM_400x400.jpeg" - , _twitter = "tobi" - , _blurb = "Shopify CEO by day, Dad in the evening, hacker at night. - Rails Core alumni; Author of ActiveMerchant, Liquid. Comprehensivist" - , _website = "https://www.shopify.com" - , _books = [ Book { _title = "Influence" - , _author ="Robert B. Cialdini" - , _amznref = "006124189X" - } - , Book { _title = "High Output Management" - , _author ="Andrew S. Grove" - , _amznref = "B015VACHOK" - } - ] - } - , Person { _name = "Susan Cain" - , _pic = "https://pbs.twimg.com/profile_images/1474290079/SusanCain5smaller-1_400x400.jpg" - , _twitter = "susancain" - , _blurb = "Bestselling author, award-winning speaker, http://Quietrev.com curator. Lover of bittersweet music & bittersweet chocolate, in equal measure." - , _website = "https://www.quietrev.com" - , _books = [ Book { _title = "Bird by Bird" - , _author ="Anne Lamott" - , _amznref = "0385480016" - } - , Book { _title = "Waking Up" - , _author ="Sam Harris" - , _amznref = "1451636024" - } - ] - } - , Person { _name = "Oprah Winfrey" - , _pic = "https://pbs.twimg.com/profile_images/1013835283698049025/q5ZN4yv3_400x400.jpg" - , _twitter = "Oprah" - , _blurb = "Oprah Winfrey is an American media executive, actress, talk show host, television producer and philanthropis" - , _website = "http://www.oprah.com/index.html" - , _books = [ Book { _title = "A New Earth" - , _author ="Eckhart Tolle" - , _amznref = "B000PC0S5K" - } - , Book { _title = "The Poisonwood Bible" - , _author ="Barbara Kingsolver" - , _amznref = "B000QTE9WU" - } - ] - } - , Person { _name = "Patrick Collison" - , _pic = "https://pbs.twimg.com/profile_images/825622525342199809/_iAaSUQf_400x400.jpg" - , _twitter = "patrickc" - , _blurb = "Fallibilist, optimist. Stripe CEO" - , _website = "https://patrickcollison.com" - , _books = [ Book { _title = "How Judges Think" - , _author ="Richard A. Posner" - , _amznref = "0674048067" - } - , Book { _title = "Programmers at Work" - , _author ="Susan Lammers" - , _amznref = "1556152116" - } - ] - } - , Person { _name = "Luis Von Ahn" - , _pic = "https://pbs.twimg.com/profile_images/1020343581087678464/NIXD5MdC_400x400.jpg" - , _twitter = "LuisvonAhn" - , _blurb = "CEO & co-founder of duolingo. Invented reCAPTCHA. Computer science professor at Carnegie Mellon. Proud Guatemalan" - , _website = "https://www.duolingo.com/" - , _books = [ Book { _title = "Zero to One" - , _author ="Peter Thiel" - , _amznref = "B00J6YBOFQ" - } - , Book { _title = "The Hard Thing About Hard Things" - , _author ="Ben Horowitz" - , _amznref = "B00DQ845EA" - } - ] - } - , Person { _name = "Bryan Johnson" - , _pic = "https://pbs.twimg.com/profile_images/1055165076372475904/vNp60sSl_400x400.jpg" - , _twitter = "bryan_johnson" - , _blurb = "Founder of Kernel, OS Fund and Braintree. Trying to go where there is no destination" - , _website = "https://bryanjohnson.co" - , _books = [ Book { _title = "A Good Man" - , _author ="Mark Shriver" - , _amznref = "B007CLBH0M" - } - , Book { _title = "Shackleton" - , _author ="Nick Bertozzi" - , _amznref = "1596434511" - } - ] - } - , Person { _name = "Peter Thiel" - , _pic = "https://pbs.twimg.com/profile_images/1121220551/Peter_Thiel_400x400.jpg" - , _twitter = "peterthiel" - , _blurb = "Technology entrepreneur, investor, philanthropist." - , _website = "http://zerotoonebook.com" - , _books = [ Book { _title = "Deceit, Desire, and the Novel" - , _author ="René Girard" - , _amznref = "0801818303" - } - , Book { _title = "Violence and the Sacred" - , _author ="René Girard" - , _amznref = "0801822181" - } - ] - } - , Person { _name = "Tim Ferris" - , _pic = "https://pbs.twimg.com/profile_images/49918572/half-face-ice_400x400.jpg" - , _twitter = "tferriss" - , _blurb = "Author of 5 #1 NYT/WSJ bestsellers, investor (FB, Uber, Twitter, 50+ more: http://angel.co/tim ), host of The Tim Ferriss Show podcast (300M+ downloads)" - , _website = "http://tim.blog" - , _books = [ Book { _title = "10% Happier" - , _author ="Dan Harris" - , _amznref = "0062265431" - } - , Book { _title = "A Guide to the Good Life" - , _author ="William Irvine" - , _amznref = "B0040JHNQG" - } - ] - } - , Person { _name = "Allen Walton" - , _pic = "https://pbs.twimg.com/profile_images/1038905908678545409/yUbF9Ruc_400x400.jpg" - , _twitter = "allenthird" - , _blurb = "Created http://SpyGuy.com and blogs about stuff at http://AllenWalton.com . All things ecommerce, personal dev, and Simpsons." - , _website = "https://www.allenwalton.com" - , _books = [ Book { _title = "4 Hour Work Week" - , _author ="Tim Ferris" - , _amznref = "B002WE46UW" - } - , Book { _title = "Choose Yourself" - , _author ="James Altucher" - , _amznref = "B00CO8D3G4" - } - ] - } - , Person { _name = "Peter Mallouk" - , _pic = "https://pbs.twimg.com/profile_images/713172266968715264/KsyDYghf_400x400.jpg" - , _twitter = "PeterMallouk" - , _blurb = "President of Creative Planning. Author “5 Mistakes Every Investor Makes & How to Avoid Them”. Radically moderate." - , _website = "https://creativeplanning.com" - , _books = [ Book { _title = "Awareness" - , _author ="Anthony de Mello SJ" - , _amznref = "B005GFBP6W" - } - , Book { _title = "The Prophet" - , _author ="Kahlil Gibran" - , _amznref = "B07NDJ3LMW" - } - ] - } - , Person { _name = "Adam Robinson" - , _pic = "https://pbs.twimg.com/profile_images/822708907051077632/y5KyboMV_400x400.jpg" - , _twitter = "IAmAdamRobinson" - , _blurb = "Entrepreneur. Systems builder. Wizard. Shaman of global financial markets. Manifester. Didact. Do-gooder. Alchemist. Aphorist. Seeker. Embracer of possibility." - , _website = "http://robinsonglobalstrategies.com" - , _books = [ Book { _title = "Wishcraft" - , _author ="Barbara Sher" - , _amznref = "0345465180" - } - , Book { _title = "You Can Be a Stock Market Genius" - , _author ="Joel Greenblatt" - , _amznref = "0684832135" - } - ] - } - , Person { _name = "Andrew Weil" - , _pic = "https://pbs.twimg.com/profile_images/987461787422359553/mpoZAmPH_400x400.jpg" - , _twitter = "DrWeil" - , _blurb = "A world-renowned leader and pioneer in the field of integrative medicine, a healing oriented approach to health care which encompasses body, mind, and spirit." - , _website = "https://www.drweil.com" - , _books = [ Book { _title = "The Way Of Life According To Lao Tzu" - , _author = "Witter Byner" - , _amznref = "0399512985" - } - , Book { _title = "The Psychology of Romantic Love" - , _author ="Nathaniel Branden" - , _amznref = "B0012RMVJI" - } - ] - } - , Person { _name = "Hubert Joly" - , _pic = "https://scontent-ort2-2.xx.fbcdn.net/v/t1.0-1/c1.0.193.193a/38444401_2156120597936470_9028564067043770368_n.jpg?_nc_cat=104&_nc_ht=scontent-ort2-2.xx&oh=162142edb167f389a5b585a329e4993a&oe=5CE1D578" - , _twitter = "BBYCEO" - , _blurb = "CEO of Best Buy" - , _website = "https://www.bestbuy.com" - , _books = [ Book { _title = "Who Says Elephants Can't Dance" - , _author = "Louis. V. Gerstner" - , _amznref = "0060523808" - } - , Book { _title = "Onward" - , _author ="Howard Schultz" - , _amznref = "1609613821" - } - ] - } - , Person { _name = "Esther Perel" - , _pic = "https://pbs.twimg.com/profile_images/1091062675151319040/MzxCcgdU_400x400.jpg" - , _twitter = "EstherPerel" - , _blurb = "Exploring modern relationships. Author of MatingInCaptivity and TheStateOfAffairsBook. Podcast: WhereShouldWeBegin. Psychotherapist in NYC." - , _website = "https://www.estherperel.com" - , _books = [ Book { _title = "Crime And Punishment" - , _author = "Fyodor Dostoyevsky" - , _amznref = "B07NL94DFD" - } - , Book { _title = "If This Is a Man and The Truce" - , _author ="Primo Levi" - , _amznref = "0349100136" - } - ] - } - , Person { _name ="Neil deGrasse Tyson" - , _pic = "https://pbs.twimg.com/profile_images/74188698/NeilTysonOriginsA-Crop_400x400.jpg" - , _twitter = "neiltyson" - , _blurb = "Astrophysicistthe. Fifth head since 1935 of the world-renowned Hayden Planetarium in New York City and the first occupant of its Frederick P. Rose Directorship. Research associate of the Department of Astrophysics at the American Museum of Natural History." - , _website = "https://www.haydenplanetarium.org/tyson/" - , _books = [ Book { _title = "The Prince" - , _author = "Machiavelli" - , _amznref = "B07ND3CM16" - } - , Book { _title = "The Art of War" - , _author ="Sun Tzu" - , _amznref = "1545211957" - } - ] - } - , Person { _name = "Mark Cuban" - , _pic = "https://pbs.twimg.com/profile_images/1422637130/mccigartrophy_400x400.jpg" - , _twitter = "mcuban" - , _blurb = "Owner of Dallas Mavericks, Shark on ABC’s Shark Tank, chairman and CEO of AXS tv, and investor in an ever-growing portfolio of businesses" - , _website = "http://markcubancompanies.com/" - , _books = [ Book { _title = "The Fountainhead" - , _author = "Ayn Rend" - , _amznref = "0452273331" - } - , Book { _title = "The Gospel of Wealth " - , _author ="Andrew Carnegie" - , _amznref = "1409942171" - } - ] - } - , Person { _name = "Robert Herjavec" - , _pic = "https://pbs.twimg.com/profile_images/608643660876423170/DgxUW3eZ_400x400.jpg" - , _twitter = "robertherjavec" - , _blurb = "Dad, Husband, Founder & CEO of global cybersecurity firm HerjavecGroup, Shark on ABC’s Shark Tank, Former Dragon, Author" - , _website = "https://www.robertherjavec.com/" - , _books = [ Book { _title = "Why I Run" - , _author = "Mark Sutcliffe" - , _amznref = "B007OC9P3A" - } - , Book { _title = "Swim with the Sharks Without Being Eaten Alive" - , _author ="Harvey B. Mackay" - , _amznref = "006074281X" - } - ] - } - , Person { _name = "Caterina Fake" - , _pic = "https://pbs.twimg.com/profile_images/378800000509318185/d968d62d1bc39f2c82d3fa44db478525_400x400.jpeg" - , _twitter = "Caterina" - , _blurb = "Host, Should this Exist? Investor, Yes VC. Cofounder: Flickr, Hunch, Sesat School. Etsy. Sundance. Homeschooling, film, literature. Dogs." - , _website = "https://caterina.net" - , _books = [ Book { _title = "Growth of the Soil" - , _author = "Knut Hamsun" - , _amznref = "0343181967" - } - , Book { _title = "The Thousand Autumns of Jacob de Zoet" - , _author ="David Mitchell" - , _amznref = "0812976363" - } - ] - } - , Person { _name = "Daymond John" - , _pic = "https://pbs.twimg.com/profile_images/1048022980863954944/eZvGANn0_400x400.jpg" - , _twitter = "TheSharkDaymond" - , _blurb = "CEO of FUBU, Shark on ABC’s Shark Tank, Author." - , _website = "https://daymondjohn.com/" - , _books = [ Book { _title = "Think and Grow Rich" - , _author = "Napoleon Hill" - , _amznref = "1585424331" - } - , Book { _title = "How to Win Friends & Influence People" - , _author ="Dale Carnegie" - , _amznref = "0671027034" - } - ] - } - , Person { _name = "Kevin O'Leary" - , _pic = "https://pbs.twimg.com/profile_images/1067383195597889536/cP6tNEt0_400x400.jpg" - , _twitter = "kevinolearytv" - , _blurb = "Chairman O'Shares ETFs, 4 time Emmy Award winning Shark Tank's Mr. Wonderful, bestselling author, CNBC contributor, wine maker, guitar dude and photographer." - , _website = "http://askmrwonderful.eone.libsynpro.com/" - , _books = [ Book { _title = "Competitive Advantage" - , _author = "Michael Porter" - , _amznref = "0684841460" - } - , Book { _title = "Secrets of Closing the Sale" - , _author ="Zig Ziglar" - , _amznref = "0425081028" - } - ] - } - , Person { _name = "Alex Rodriguez" - , _pic = "https://pbs.twimg.com/profile_images/796405335388848128/LbvsjCA3_400x400.jpg" - , _twitter = "AROD" - , _blurb = "3-time MVP • 14-time All Star • World Series Champ • CEO of @_ARodCorp• @FoxSports Commentator/Analyst • Special Advisor to the Yankees, @ABCSharkTank and ESPN" - , _website = "http://www.arodcorp.com/" - , _books = [ Book { _title = "Blitzscaling" - , _author = "Reid Hoffman" - , _amznref = "1524761419" - } - , Book { _title = "Measure What Matters" - , _author ="John Doerr" - , _amznref = "0525536221" - } - ] - } - ] diff --git a/lore/Biz/Ibb/Keep.hs b/lore/Biz/Ibb/Keep.hs deleted file mode 100644 index ad7dcbc..0000000 --- a/lore/Biz/Ibb/Keep.hs +++ /dev/null @@ -1,124 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- | Keep is a database built on Data.Acid. --- --- If this proves useful, maybe we could make it a more general thing. Like --- `Biz.Keep`. I could wrap all the safecopy stuff in my own template haskell --- like `$(keep ''MyType)`. --- -module Biz.Ibb.Keep where - -import Biz.Ibb.Core (Person(..), Book(..)) -import Control.Monad.State (get, put) -import Control.Monad.Reader (ask) -import Data.Acid (Update, makeAcidic) -import qualified Data.Acid as Acid -import Data.Data (Data, Typeable) -import Data.IxSet (Indexable(..), IxSet, ixFun, ixSet) -import qualified Data.IxSet as IxSet -import Data.SafeCopy -import Data.Text (Text) -import qualified Data.Text as Text - -import qualified Biz.Ibb.Influencers as Influencers - --- * Keep - --- | Main database. Need to think of a better name for this. -data IbbKeep = IbbKeep - { _people :: IxSet Person - } - deriving (Data, Typeable) - -$(deriveSafeCopy 0 'base ''IbbKeep) - --- * Index @Person@ - -$(deriveSafeCopy 0 'base ''Person) - -newtype PersonName = - PersonName Text deriving (Eq, Ord, Data, Typeable) - -newtype PersonBlurb = - PersonBlurb Text deriving (Eq, Ord, Data, Typeable) - -instance Indexable Person where - empty = ixSet - [ ixFun $ \p -> [ PersonName $ _name p ] - , ixFun $ \p -> [ _pic p ] - , ixFun $ \p -> [ _twitter p ] - , ixFun $ \p -> [ _website p ] - , ixFun $ \p -> [ _books p ] - , ixFun $ \p -> [ PersonBlurb $ _blurb p ] - ] - --- | updates the `IbbKeep` with a new `Person` -newPerson :: Text -> Text -> Update IbbKeep Person -newPerson name blurb = do - k <- get - put $ k { _people = IxSet.insert p (_people k) - } - return p - where - p = Person - { _name = name - , _pic = Text.empty - , _twitter = Text.empty - , _website = Text.empty - , _books = [] - , _blurb = blurb - } - -getPeople :: Int -> Acid.Query IbbKeep [Person] -getPeople n = do - keep <- ask - return $ take n $ IxSet.toList $ _people keep - --- * Index @Book@ - -$(deriveSafeCopy 0 'base ''Book) - -newtype BookTitle = - BookTitle Text deriving (Eq, Ord, Data, Typeable) - -newtype BookAuthor = - BookAuthor Text deriving (Eq, Ord, Data, Typeable) - -instance Indexable Book where - empty = ixSet - [ ixFun $ \b -> [ BookTitle $ _title b ] - , ixFun $ \b -> [ BookAuthor $ _author b ] - , ixFun $ \b -> [ _amznref b ] - ] - --- | updates the `IbbKeep` with a new `Book` ---newBook :: Text -> Text -> Text -> Update IbbKeep Book ---newBook title author amznref = do --- ibbKeep <- get --- put $ ibbKeep { _books = IxSet.insert b (_books ibbKeep) --- , _people = _people ibbKeep --- } --- return b --- where --- b = Book { _title = title --- , _author = author --- , _amznref = amznref --- } - --- * Opening the keep - --- defines @NewPerson@ for us. -$(makeAcidic ''IbbKeep ['newPerson, 'getPeople]) - -initialIbbKeep :: IbbKeep -initialIbbKeep = IbbKeep - { _people = IxSet.fromList Influencers.allPeople - } - -openLocal :: String -> IO (Acid.AcidState IbbKeep) -openLocal dir = - Acid.openLocalStateFrom dir initialIbbKeep diff --git a/lore/Biz/Ibb/Look.hs b/lore/Biz/Ibb/Look.hs deleted file mode 100644 index 9017ba2..0000000 --- a/lore/Biz/Ibb/Look.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NoImplicitPrelude #-} - --- | The look and feel of Ibb -module Biz.Ibb.Look where - -import Alpha -import Clay -import qualified Clay.Stylesheet as Stylesheet -import qualified Clay.Render as Clay -import qualified Clay.Flexbox as Flexbox -import qualified Clay.Media as Media - -main :: Css -main = do - "html" <> "body" ? do - width (pc 100) - display flex - flexDirection column - alignItems center - alignContent center - justifyContent center - ".container" ? do - width (px 900) - display flex - justifyContent center - flexDirection column diff --git a/lore/Biz/Ibb/Move.hs b/lore/Biz/Ibb/Move.hs deleted file mode 100644 index 0d83e8a..0000000 --- a/lore/Biz/Ibb/Move.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - --- | App update logic -module Biz.Ibb.Move ( - move - -- * Server interactions - , fetchPeople - ) where - -import Alpha -import Data.Aeson -import Biz.Ibb.Core as Core -import JavaScript.Web.XMLHttpRequest (Request(..), Method(GET), RequestData(NoData), contents, xhrByteString) -import Miso -import Miso.String -import Network.RemoteData - -move :: Action -> Model -> Effect Action Model -move Nop m = noEff m -move (HandleRoute u) m = m { uri = u } <# pure Nop -move (ChangeRoute u) m = m <# do pushURI u >> pure Nop -move FetchPeople m = m <# (SetPeople /@ fetchPeople) -move (SetPeople ps) m = noEff m { people = ps } - -fetchPeople :: IO (WebData [Core.Person]) -fetchPeople = do - mjson <- contents /@ xhrByteString req - case mjson of - Nothing -> pure $ Failure "could not read from server" - Just a -> pure - $ fromEither - $ either (Left . ms) pure - $ eitherDecodeStrict a - where - req = Request { reqMethod = GET - -- FIXME: can replace this hardcoding with a function? - , reqURI = "/api/people" - , reqLogin = Nothing - , reqHeaders = [] - , reqWithCredentials = False - , reqData = NoData - } diff --git a/lore/Control/Concurrent/Go.hs b/lore/Control/Concurrent/Go.hs deleted file mode 100644 index 711611f..0000000 --- a/lore/Control/Concurrent/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 Control.Concurrent.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/lore/Control/Concurrent/Sima.hs b/lore/Control/Concurrent/Sima.hs deleted file mode 100644 index b69c0bb..0000000 --- a/lore/Control/Concurrent/Sima.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Control.Concurrent.Sima - ( 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/lore/Language/Bs.hs b/lore/Language/Bs.hs deleted file mode 100644 index a810706..0000000 --- a/lore/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/lore/Language/Bs/Cli.hs b/lore/Language/Bs/Cli.hs deleted file mode 100644 index 4c48c86..0000000 --- a/lore/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/lore/Language/Bs/Eval.hs b/lore/Language/Bs/Eval.hs deleted file mode 100644 index 290170b..0000000 --- a/lore/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 )" - -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 )" - - -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 )" - - --- 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/lore/Language/Bs/Expr.hs b/lore/Language/Bs/Expr.hs deleted file mode 100644 index a39c7b6..0000000 --- a/lore/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 "" - - Func _ _ -> - textStrict "" - - 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/lore/Language/Bs/Parser.hs b/lore/Language/Bs/Parser.hs deleted file mode 100644 index 3044a60..0000000 --- a/lore/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) "" - -readExprFile :: SourceName -> T.Text -> Either ParseError Expr -readExprFile = parse (contents (List <$> manyExpr)) diff --git a/lore/Language/Bs/Primitives.hs b/lore/Language/Bs/Primitives.hs deleted file mode 100644 index c074c59..0000000 --- a/lore/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/lore/Language/Bs/Repl.hs b/lore/Language/Bs/Repl.hs deleted file mode 100644 index 64ffaa2..0000000 --- a/lore/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/lore/Language/Bs/Test.hs b/lore/Language/Bs/Test.hs deleted file mode 100644 index 4a40036..0000000 --- a/lore/Language/Bs/Test.hs +++ /dev/null @@ -1,2 +0,0 @@ --- TODO -module Language.Bs.Test where diff --git a/lore/Network/RemoteData.hs b/lore/Network/RemoteData.hs deleted file mode 100644 index 2fe6557..0000000 --- a/lore/Network/RemoteData.hs +++ /dev/null @@ -1,31 +0,0 @@ --- | A port of Kris Jenkins' RemoteData Elm module --- . --- -module Network.RemoteData 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/lore/System/Random/Shuffle.hs b/lore/System/Random/Shuffle.hs deleted file mode 100644 index 02cd3e0..0000000 --- a/lore/System/Random/Shuffle.hs +++ /dev/null @@ -1,122 +0,0 @@ -{- | -Module : System.Random.Shuffle -Copyright : (c) 2009 Oleg Kiselyov, Manlio Perillo -License : BSD3 (see LICENSE file) - - - - -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/lore/bild.nix b/lore/bild.nix deleted file mode 100644 index 589fda9..0000000 --- a/lore/bild.nix +++ /dev/null @@ -1,56 +0,0 @@ -{ - # a common build function - # - # see example usage in pack/ibb.nix. this is not set in stone, obviously. we - # should figure out how to use overlays, for one. - # - bild = file: { nixpkgs }: - with nixpkgs; - let - pack = import file; - - depsToPackageSet = packageSet: deps: - map (s: builtins.getAttr s packageSet) deps; - - ghc844_ = pkgs.haskell.packages.ghc844.override (oldAttrs: { - overrides = with pkgs.haskell.lib; self: super: { - clay = dontCheck super.clay; - }; - }); - - ghc = ghc844_.ghcWithPackages (hp: depsToPackageSet hp - # we need hinotify for chip/make - ([ "hinotify" ] ++ pack.deps.both ++ pack.deps.apex)); - - 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 (pack.deps.both ++ pack.deps.aero)); - - make = ../chip/make; - in - stdenv.mkDerivation { - name = pack.name; - version = "0"; - src = ../.; - nativeBuildInputs = [ - ghc ghcjs - ]; - strictDeps = true; - buildPhase = "${ghc}/bin/runhaskell ${make} ${pack.name}"; - installPhase = '' - mkdir -p $out/bin - cp bild/${pack.name} $out/bin/${pack.name} - ''; - }; -} diff --git a/lore/core.scm b/lore/core.scm deleted file mode 100644 index 3d411c4..0000000 --- a/lore/core.scm +++ /dev/null @@ -1,59 +0,0 @@ -;; standard library for bs - -(define (not x) (if x #f #t)) -(define (null? obj) (if (eqv? obj '()) #t #f)) -(define (list objs) objs) -(define (identity obj) obj) -(define (flip f) (lambda (x y) (f y x))) -(define (curry f a) (lambda (b) (apply f (cons a (list b))))) -(define (compose f g) (lambda (x) (f (apply g x)))) -(define zero? (curry = 0)) -(define positive? (curry < 0)) -(define negative? (curry > 0)) -(define (odd? n) (= (mod n 2) 1)) -(define (even? n) (= (mod n 2) 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 (mem* pred op) - (lambda (acc next) - (if (and (not acc) (pred (op next))) - next - acc))) - -(define (sum lst) (fold + 0 lst)) -(define (produce lst) (fold * 0 1 lst)) - -(define (max nums) - (fold (lambda (x y) (if (> x y) x y)) - (car nums) (cdr nums))) - -(define (min nums) - (fold (lambda (x y) (if (< x y) x y)) - (car nums) (cdr nums))) - -(define (length lst) (fold (lambda (x y) (+ x 1)) 0 lst)) -(define (reverse lst) (fold (flip cons) '() lst)) -(define (memq obj lst) (fold (mem* (curry eq? obj) identity) #f lst)) -(define (memv obj lst) (fold (mem* (curry eqv? obj) identity) #f lst)) -(define (member obj lst) (fold (mem* (curry equal? obj) identity) #f lst)) -(define (assq obj alist) (fold (mem* (curry eq? obj) car) #f alist)) -(define (assv obj alist) (fold (mem* (curry eqv? obj) car) #f alist)) -(define (assoc obj alist) (fold (mem* (curry equal? obj) car) #f alist)) -(define (map f lst) (foldr (lambda (x y) (cons (f x) y)) '() lst)) -(define (filter pred lst) (foldr (lambda (x y) (if (pred x) (cons x y) y)) '() lst)) diff --git a/lore/sicp/meta.scm b/lore/sicp/meta.scm deleted file mode 100644 index 94dc784..0000000 --- a/lore/sicp/meta.scm +++ /dev/null @@ -1,20 +0,0 @@ -(define (eval exp env) - (cond - ((self-evaluating? exp) exp) - ((variable? exp) (lookup-variable-value exp env)) - ((quoted? exp) (text-of-quotation exp)) - ((assignment? exp) (eval-assignment exp env)) - ((definition? exp) (eval-definition exp env)) - ((if? exp) (eval-if exp env)) - ((lambda? exp) - (make-procedure (lambda-parameters exp) - (lambda-body exp) - env)) - ((begin? exp) - (eval-sequence (begin-actions exp) env)) - ((cond? exp) (eval (cond->if exp) env)) - ((application? exp) - (apply (eval (operator exp) env) - (list-of-values (operands exp) env))) - (else - (error "Unknown expression type -- EVAL" exp)))) diff --git a/lore/sicp/set.scm b/lore/sicp/set.scm deleted file mode 100644 index 3d60c5c..0000000 --- a/lore/sicp/set.scm +++ /dev/null @@ -1,42 +0,0 @@ -;; A set module, based on binary trees (from sicp) - -(define (entry tree) (car tree)) -(define (left-branch tree) (cadr tree)) -(define (right-branch tree) (caddr tree)) - -(define (make-tree entry left right) - (list entry left right)) - -(define (element-of-set? x set) - (cond ((null? set) #f) - ((= x (entry set)) #t) - ((< x (entry set)) - (element-of-set? x (left-branch set))) - ((> x (entry set)) - (element-of-set? x (right-branch set))))) - -(define (adjoin-set x set) - (cond ((null? set) (make-tree x '() '())) - ((= x (entry set)) set) - ((< x (entry set)) - (make-tree (entry set) - (adjoin-set x (left-branch set)) - (right-branch set))) - ((> x (entry set)) - (make-tree (entry set) - (left-branch set) - (adjoin-set x (right-branch set)))))) - -(define (intersection-set set1 set2) - (if (or (null? set1) (null? set2)) - '() - (let ((x1 (car set1)) - (x2 (car set2))) - (cond ((= x1 x2) - (cons x1 - (intersection-set (cdr set1) - (cdr set2)))) - ((< x1 x2) - (intersection-set (cdr set1) set2)) - ((< x2 x1) - (intersection-set set1 (cdr set2))))))) diff --git a/mode/fathom.nix b/mode/fathom.nix deleted file mode 100644 index dee34b9..0000000 --- a/mode/fathom.nix +++ /dev/null @@ -1,93 +0,0 @@ -{ options -, lib -, config -, pkgs -, modulesPath -}: - -with lib; - -let - cfg = config.services.fathom; -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/mode/ibb.nix b/mode/ibb.nix deleted file mode 100644 index ffc7cb4..0000000 --- a/mode/ibb.nix +++ /dev/null @@ -1,42 +0,0 @@ -{ options -, lib -, config -, pkgs -, modulesPath -}: - -let - cfg = config.services.ibb; -in -{ - options.services.ibb = { - enable = lib.mkEnableOption "Enable the IBB service"; - port = lib.mkOption { - type = lib.types.string; - default = "3000"; - description = '' - The port on which IBB will listen for - incoming HTTP traffic. - ''; - }; - }; - config = lib.mkIf cfg.enable { - systemd.services.ibb = { - path = with pkgs; [ ibb bash ]; - wantedBy = [ "multi-user.target" ]; - script = '' - PORT=${cfg.port} ./bin/ibb - ''; - description = '' - Influenced By Books website - ''; - serviceConfig = { - WorkingDirectory=pkgs.ibb; - KillSignal="INT"; - Type = "simple"; - Restart = "on-abort"; - RestartSec = "10"; - }; - }; - }; -} diff --git a/nixpkgs.nix b/nixpkgs.nix new file mode 100644 index 0000000..5d8dc56 --- /dev/null +++ b/nixpkgs.nix @@ -0,0 +1,5 @@ +# generated with ~/bin/nix-pin +{ + url = "https://github.com/NixOS/nixpkgs/archive/0715f2f1a9b3a1c15ddf3f7386a6d58c9a1bbe2d.tar.gz"; + sha256 = "0awm087hnsx0x5phxna5a0cm9ir6m7vha94b0q0zq5lb24clgr6s"; +} diff --git a/pack/bs.nix b/pack/bs.nix deleted file mode 100644 index d869dd1..0000000 --- a/pack/bs.nix +++ /dev/null @@ -1,39 +0,0 @@ -{ nixpkgs }: -with nixpkgs; -let - ghc = pkgs.haskell.packages.ghc844.ghcWithPackages (hp: with hp; [ - hinotify - - containers - directory - haskeline - HTTP - mtl - optparse-applicative - parsec - protolude - text - transformers - wl-pprint-text - ]); - entrypoint = "Bs"; -in -stdenv.mkDerivation rec { - name = "bs"; - version = "0"; - src = ../.; - nativeBuildInputs = [ - ghc - ]; - strictDeps = true; - buildPhase = '' - ${ghc}/bin/ghc \ - -iapex -ilore \ - -main-is ${entrypoint} --make apex/${entrypoint}.hs \ - -o bild/${name} - ''; - installPhase = '' - mkdir -p $out/bin - cp bild/${name} $out/bin/${name} - ''; -} diff --git a/pack/buildeasy.nix b/pack/buildeasy.nix deleted file mode 100644 index f5b0963..0000000 --- a/pack/buildeasy.nix +++ /dev/null @@ -1,30 +0,0 @@ -{ - # n.b.: 'buildeasy' is already taken by webuildeasy.com. we might want to find - # another name. - # - name = "buildeasy"; - deps = { - both = [ - "miso" - "protolude" - "servant" - "text" - ]; - apex = [ - "acid-state" - "blaze-html" - "blaze-markup" - "bytestring" - "ixset" - "safecopy" - "scotty" - "servant-server" - "text" - ]; - aero = [ - "aeson" - "containers" - "ghcjs-base" - ]; - }; -} diff --git a/pack/cmdwave.nix b/pack/cmdwave.nix deleted file mode 100644 index a26945c..0000000 --- a/pack/cmdwave.nix +++ /dev/null @@ -1,30 +0,0 @@ -{ nixpkgs }: -with nixpkgs; -let - ghc = pkgs.haskell.packages.ghc844.ghcWithPackages (hp: with hp; [ - hinotify - - protolude - pulse-simple - ]); - entrypoint = "Cmdwave"; -in -stdenv.mkDerivation rec { - name = "cmdwave"; - version = "0"; - src = ../.; - nativeBuildInputs = [ - ghc - ]; - strictDeps = true; - buildPhase = '' - ${ghc}/bin/ghc \ - -iapex -ilore \ - -main-is ${entrypoint} --make apex/${entrypoint}.hs \ - -o bild/${name} - ''; - installPhase = '' - mkdir -p $out/bin - cp bild/${name} $out/bin/${name} - ''; -} diff --git a/pack/default.nix b/pack/default.nix deleted file mode 100644 index ece0378..0000000 --- a/pack/default.nix +++ /dev/null @@ -1,12 +0,0 @@ -{ nixpkgs }: - -with import ../lore/bild.nix; - -{ - bs = import ./bs.nix { inherit nixpkgs; }; - cmdwave = import ./cmdwave.nix { inherit nixpkgs; }; - duree = import ./duree.nix { inherit nixpkgs; }; - fathom = import ./fathom.nix { inherit nixpkgs; }; - ibb = bild ./ibb.nix { inherit nixpkgs; }; - buildeasy = bild ./buildeasy.nix { inherit nixpkgs; }; -} diff --git a/pack/duree.nix b/pack/duree.nix deleted file mode 100644 index 84b82da..0000000 --- a/pack/duree.nix +++ /dev/null @@ -1,33 +0,0 @@ -{ nixpkgs }: -with nixpkgs; -let - ghc = pkgs.haskell.packages.ghc844.ghcWithPackages (hp: with hp; [ - hinotify - - mongoDB - mtl - protolude - text - transformers - ]); - entrypoint = "Duree"; -in -stdenv.mkDerivation rec { - name = "duree"; - version = "0"; - src = ../.; - nativeBuildInputs = [ - ghc - ]; - strictDeps = true; - buildPhase = '' - ${ghc}/bin/ghc \ - -iapex -ilore \ - -main-is ${entrypoint} --make apex/${entrypoint}.hs \ - -o bild/${name} - ''; - installPhase = '' - mkdir -p $out/bin - cp bild/${name} $out/bin/${name} - ''; -} diff --git a/pack/fathom.nix b/pack/fathom.nix deleted file mode 100644 index a845eb6..0000000 --- a/pack/fathom.nix +++ /dev/null @@ -1,18 +0,0 @@ -{ nixpkgs }: -with nixpkgs; -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 - ''; -} diff --git a/pack/ibb.nix b/pack/ibb.nix deleted file mode 100644 index 12f8eb4..0000000 --- a/pack/ibb.nix +++ /dev/null @@ -1,31 +0,0 @@ -{ - name = "ibb"; - deps = { - both = [ - "clay" - "miso" - "protolude" - "servant" - "text" - ]; - apex = [ - "MonadRandom" - "acid-state" - "blaze-html" - "blaze-markup" - "bytestring" - "githash" - "ixset" - "random" - "safecopy" - "scotty" - "servant-server" - "text" - ]; - aero = [ - "aeson" - "containers" - "ghcjs-base" - ]; - }; -} diff --git a/pack/nixpkgs.nix b/pack/nixpkgs.nix deleted file mode 100644 index 5d8dc56..0000000 --- a/pack/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/pack/overlay.nix b/pack/overlay.nix deleted file mode 100644 index b19eeb7..0000000 --- a/pack/overlay.nix +++ /dev/null @@ -1,3 +0,0 @@ -self: super: - -import ./default.nix { nixpkgs = super; } -- cgit v1.2.3