From 9756eb0806aef63137ed53c7f78eee13aa3db9d7 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 1 Nov 2019 14:24:24 -0700 Subject: add buildHaskellApp nix function --- .dir-locals.el | 2 + .envrc | 1 + com/influencedbybooks/aero.hs | 6 +-- com/influencedbybooks/apex.hs | 15 +++---- com/influencedbybooks/core.hs | 2 +- com/influencedbybooks/default.nix | 32 --------------- com/influencedbybooks/influencers.hs | 4 +- com/influencedbybooks/keep.hs | 6 +-- com/influencedbybooks/look.hs | 2 +- com/influencedbybooks/move.hs | 4 +- com/simatime/bild.scm | 24 ++--------- com/simatime/buildHaskellApp.nix | 79 ++++++++++++++++++++++++++++++++++++ com/simatime/caplinks.scm | 45 ++++++++++++++++++++ com/simatime/shell.scm | 34 ++++++++++++++++ com/simatime/string.scm | 24 +++++++++++ default.nix | 36 +++++++++++++++- 16 files changed, 241 insertions(+), 75 deletions(-) create mode 100644 .dir-locals.el create mode 100644 .envrc delete mode 100644 com/influencedbybooks/default.nix create mode 100644 com/simatime/buildHaskellApp.nix create mode 100755 com/simatime/caplinks.scm create mode 100644 com/simatime/shell.scm create mode 100644 com/simatime/string.scm diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..ebd1f0a --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,2 @@ +((scheme-mode + . ((geiser-guile-load-path . ".")))) diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..f0cdafa --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +export GUILE_LOAD_PATH=. diff --git a/com/influencedbybooks/aero.hs b/com/influencedbybooks/aero.hs index 92d071d..63066c5 100644 --- a/com/influencedbybooks/aero.hs +++ b/com/influencedbybooks/aero.hs @@ -3,11 +3,11 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | Front-end -module Com.InfluencedByBooks.Aero where +module Com.Influencedbybooks.Aero where import Com.Simatime.Alpha -import Com.InfluencedByBooks.Move (move) -import Com.InfluencedByBooks.Core (Action(..), see, init) +import Com.Influencedbybooks.Move (move) +import Com.Influencedbybooks.Core (Action(..), see, init) import Miso (App(..), defaultEvents, miso) main :: IO () diff --git a/com/influencedbybooks/apex.hs b/com/influencedbybooks/apex.hs index fd4766b..32e6403 100644 --- a/com/influencedbybooks/apex.hs +++ b/com/influencedbybooks/apex.hs @@ -8,25 +8,24 @@ {-# LANGUAGE TypeOperators #-} -- | Server -module Com.InfluencedByBooks.Apex where +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 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 Com.Simatime.Network import Network.Wai import Network.Wai.Application.Static import Network.Wai.Handler.Warp @@ -60,10 +59,8 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where 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" diff --git a/com/influencedbybooks/core.hs b/com/influencedbybooks/core.hs index 9bd2353..2a616f3 100644 --- a/com/influencedbybooks/core.hs +++ b/com/influencedbybooks/core.hs @@ -5,7 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} -- | Main app logic -module Com.InfluencedByBooks.Core where +module Com.Influencedbybooks.Core where import Com.Simatime.Alpha import Data.Aeson hiding (Success) diff --git a/com/influencedbybooks/default.nix b/com/influencedbybooks/default.nix deleted file mode 100644 index f2ff1ec..0000000 --- a/com/influencedbybooks/default.nix +++ /dev/null @@ -1,32 +0,0 @@ -# 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 index 2583770..c0cb143 100644 --- a/com/influencedbybooks/influencers.hs +++ b/com/influencedbybooks/influencers.hs @@ -2,9 +2,9 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} -module Com.InfluencedByBooks.Influencers where +module Com.Influencedbybooks.Influencers where -import Com.InfluencedByBooks.Core +import Com.Influencedbybooks.Core allPeople :: [Person] allPeople = diff --git a/com/influencedbybooks/keep.hs b/com/influencedbybooks/keep.hs index 0bc527a..2b7ff3a 100644 --- a/com/influencedbybooks/keep.hs +++ b/com/influencedbybooks/keep.hs @@ -10,9 +10,9 @@ -- `Biz.Keep`. I could wrap all the safecopy stuff in my own template haskell -- like `$(keep ''MyType)`. -- -module Com.InfluencedByBooks.Keep where +module Com.Influencedbybooks.Keep where -import Com.InfluencedByBooks.Core (Person(..), Book(..)) +import Com.Influencedbybooks.Core (Person(..), Book(..)) import Control.Monad.State (get, put) import Control.Monad.Reader (ask) import Data.Acid (Update, makeAcidic) @@ -24,7 +24,7 @@ import Data.SafeCopy import Data.Text (Text) import qualified Data.Text as Text -import qualified Com.InfluencedByBooks.Influencers as Influencers +import qualified Com.Influencedbybooks.Influencers as Influencers -- * Keep diff --git a/com/influencedbybooks/look.hs b/com/influencedbybooks/look.hs index d61fc11..68ae81f 100644 --- a/com/influencedbybooks/look.hs +++ b/com/influencedbybooks/look.hs @@ -2,7 +2,7 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | The look and feel of Ibb -module Com.InfluencedByBooks.Look where +module Com.Influencedbybooks.Look where import Com.Simatime.Alpha import Clay diff --git a/com/influencedbybooks/move.hs b/com/influencedbybooks/move.hs index 2c0ee37..63af430 100644 --- a/com/influencedbybooks/move.hs +++ b/com/influencedbybooks/move.hs @@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} -- | App update logic -module Com.InfluencedByBooks.Move ( +module Com.Influencedbybooks.Move ( move -- * Server interactions , fetchPeople @@ -10,7 +10,7 @@ module Com.InfluencedByBooks.Move ( import Alpha import Data.Aeson -import Com.InfluencedByBooks.Core as Core +import Com.Influencedbybooks.Core as Core import JavaScript.Web.XMLHttpRequest (Request(..), Method(GET), RequestData(NoData), contents, xhrByteString) import Miso import Miso.String diff --git a/com/simatime/bild.scm b/com/simatime/bild.scm index 604a545..44f6c74 100755 --- a/com/simatime/bild.scm +++ b/com/simatime/bild.scm @@ -122,6 +122,9 @@ exec guile -e "(@ (com simatime bild) main)" -s "$0" "$@" (define-module (com simatime bild) #:use-module ((ice-9 popen) #:prefix popen/) #:use-module ((ice-9 format) #:select (format)) + #:use-module ((ice-9 rdelim) #:prefix rdelim/) + #:use-module ((com simatime shell) #:prefix sh/) + #:use-module ((com simatime string) #:prefix string/) #:export (ns? ns->path path->ns @@ -156,24 +159,3 @@ exec guile -e "(@ (com simatime bild) main)" -s "$0" "$@" ((symbol? path) (to-ns (symbol->string path))) ((string? path) (to-ns path)) (else (error "path should be a string or symbol"))))) - - -;; -;; general funs, to be moved to a core lib -;; - -(define (string/replace s match replacement) - (string-fold - (lambda (a b) - (let ((next-char (if (eq? a match) - replacement - a))) - (string-concatenate (list b (string next-char))))) - "" - s)) - -(define (sh/exec cmd) - (let* ((port (popen/open-input-pipe cmd)) - (ret (read port))) - (popen/close-pipe port) - ret)) diff --git a/com/simatime/buildHaskellApp.nix b/com/simatime/buildHaskellApp.nix new file mode 100644 index 0000000..d9cb211 --- /dev/null +++ b/com/simatime/buildHaskellApp.nix @@ -0,0 +1,79 @@ +/* + +A function for building a Haskell Miso app. + +*/ + +nixpkgs: + +{ + # the namespace. We can't figure this out with Nix code, but when we port to + # guix/scheme we should be able to + name +, apex # compiled with ghc +, aero # compiled with ghcjs + # deps get passed to GHC +, deps + +}: + +with nixpkgs; + +let + nsToPath = ns: + builtins.toString (builtins.replaceStrings ["."] ["/"] ns); + + 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 + (deps.both ++ 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 (deps.both ++ deps.aero)); + +in stdenv.mkDerivation { + name = name; + version = "0"; + src = ../../.; # this is the git root + nativeBuildInputs = [ + ghc ghcjs guile bash + ]; + strictDeps = true; + buildPhase = '' + echo ":: build" + . .envrc + guile -e '(com simatime caplinks)' -s ./com/simatime/caplinks.scm . + mkdir -p _bild/${nsToPath apex} + mkdir -p _bild/${nsToPath aero} + ${ghc}/bin/ghc -i. --make ${nsToPath apex}.hs -main-is ${apex} \ + -o _bild/${nsToPath apex} + ${ghcjs}/bin/ghcjs -i. --make ${nsToPath aero}.hs -main-is ${aero} \ + -o _bild/${nsToPath aero} + ''; + installPhase = '' + echo ":: install" + mkdir -p $out + pwd && ls -al . + cp -r ./${nsToPath apex}* $out/${apex} + cp -r ./${nsToPath aero}* $out/${aero} + ''; +} diff --git a/com/simatime/caplinks.scm b/com/simatime/caplinks.scm new file mode 100755 index 0000000..21f0b88 --- /dev/null +++ b/com/simatime/caplinks.scm @@ -0,0 +1,45 @@ + +(define-module (com simatime caplinks) + #:use-module ((ice-9 popen) #:prefix popen/) + #:use-module ((com simatime string) #:prefix string/) + #:use-module ((com simatime shell) #:prefix sh/) + #:export (main get-all-nodes make-symlink)) + +;; given a root directory, walk the tree and get a list of all the files. Then, +;; for each file, symlink a capitalized version +(define (main args) + (let* ((root (cadr args)) + (files (get-all-nodes root))) + (for-each (lambda (file) + (display file) + (move-file file (capitalize-file file))) + files) + (display root) (newline) + (display "done moving files") (newline) + (newline))) + +(define (get-all-nodes root) + (filter (lambda (s) (not (equal? "" s))) + (string-split (sh/stream + (format #f "find ~a -name '*.hs*'" root)) + #\newline))) + +(define (capitalize-file file) + (string-join (map string/capitalize (string-split file #\/)) + "/")) + +(define (butlast ls) + (let ((len (length ls))) + (list-head ls (- len 1)))) + +(define (dir-for f) + (string-join + (butlast (string-split f #\/)) + "/")) + +(define (move-file here there) + (display (format #f "~a -> ~a" here there)) + (newline) + ;; make the directory tree for the link, if it doesn't already exist + (system (format #f "mkdir -p ~a" (dir-for there))) + (system (format #f "mv ~a ~a" here there))) diff --git a/com/simatime/shell.scm b/com/simatime/shell.scm new file mode 100644 index 0000000..7c6bb5c --- /dev/null +++ b/com/simatime/shell.scm @@ -0,0 +1,34 @@ +(define-module (com simatime shell) + #:use-module ((ice-9 popen) #:prefix popen/) + #:use-module ((ice-9 rdelim) #:prefix rdelim/) + #:use-module ((ice-9 ftw) #:prefix ftw/) + #:export (exec + stream + pwd + ls + cd)) + +(define (exec cmd) + (let* ((port (popen/open-input-pipe cmd)) + (ret (read port))) + (popen/close-pipe port) + ret)) + +(define (stream cmd) + (let* ((port (popen/open-input-pipe cmd)) + (_ (setvbuf port 'none)) + (ret (rdelim/read-string port))) + (flush-all-ports) + (popen/close-pipe port) + ret)) + +(define (pwd) + (regexp-substitute/global + #f "/home/ben" (getcwd) 'pre "~" 'post)) + +(define (ls) + (ftw/scandir (getcwd))) + +(define (cd path) + (chdir path) + (ls)) diff --git a/com/simatime/string.scm b/com/simatime/string.scm new file mode 100644 index 0000000..01c5a70 --- /dev/null +++ b/com/simatime/string.scm @@ -0,0 +1,24 @@ +(define-module (com simatime string) + #:export (replace to-string str capitalize)) + +(define (replace s match repl) + (let ((f (lambda (a b) + (let ((next-char (if (eq? a match) repl a))) + (string-concatenate (list b (string next-char))))))) + (string-fold f "" s))) + +(define (to-string x) + (format #f "~a" x)) + +(define str + (case-lambda + (() "") + ((x) (to-string x)) + ((x . rest) (string-concatenate (map str (cons x rest)))))) + +(define (capitalize s) + (let ((s (to-string s))) + (if (< (string-length s) 2) + (string-upcase s) + (str (string-upcase (substring s 0 1)) + (substring s 1 ))))) diff --git a/default.nix b/default.nix index e3d3ca1..aedf4a0 100644 --- a/default.nix +++ b/default.nix @@ -8,7 +8,7 @@ let system = full.system; vm = full.vm; }; - + buildHaskellApp = import ./com/simatime/buildHaskellApp.nix nixpkgs; in { com.simatime = import ./com/simatime.nix { inherit buildNixOS; }; com.influencedbybooks = buildNixOS { @@ -28,4 +28,38 @@ in { security.sudo.wheelNeedsPassword = true; boot.cleanTmpDir = true; }; + } // { + ibb = buildHaskellApp { + name = "Com.Influencedbybooks"; + apex = "Com.Influencedbybooks.Apex"; + aero = "Com.Influencedbybooks.Aero"; + deps = { + both = [ + "clay" + "miso" + "protolude" + "servant" + "text" + ]; + apex = [ + "MonadRandom" + "acid-state" + "blaze-html" + "blaze-markup" + "bytestring" + "ixset" + "random" + "safecopy" + "scotty" + "servant-server" + "text" + ]; + aero = [ + "aeson" + "containers" + "ghcjs-base" + ]; + }; + }; + }; } -- cgit v1.2.3