diff options
| -rw-r--r-- | .envrc | 1 | ||||
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | LICENSE | 26 | ||||
| -rw-r--r-- | README.md | 14 | ||||
| -rw-r--r-- | achat.cabal | 22 | ||||
| -rw-r--r-- | app/Main.hs | 147 | ||||
| -rw-r--r-- | app/index.html | 11 | ||||
| -rw-r--r-- | cabal.project | 3 | ||||
| -rw-r--r-- | default.nix | 27 | ||||
| -rw-r--r-- | nix/sources.json | 26 | ||||
| -rw-r--r-- | nix/sources.nix | 198 | ||||
| -rw-r--r-- | pkgs/default.nix | 23 | ||||
| -rw-r--r-- | shell.nix | 1 |
13 files changed, 501 insertions, 0 deletions
@@ -0,0 +1 @@ +use nix diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0424d86 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/dist-newstyle +/.emcache @@ -0,0 +1,26 @@ +Copyright (c) 2025, Alexander Foremny +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the + distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..168a8b5 --- /dev/null +++ b/README.md @@ -0,0 +1,14 @@ +# achat + +## cabal (development) + +```console +cabal build +firefox dist-newstyle/build/javascript-ghcjs/ghc-9.10.1/achat-0.1.0.0/x/achat/build/achat/achat.jsexe/index.html +``` + +## nix (package) + +```console +firefox $(nix-build --no-out-link -A achat)/share/achat.jsexe/index.html +``` diff --git a/achat.cabal b/achat.cabal new file mode 100644 index 0000000..766bf67 --- /dev/null +++ b/achat.cabal @@ -0,0 +1,22 @@ +cabal-version: 3.4 +name: achat +version: 0.1.0.0 +license: BSD-2-Clause +license-file: LICENSE +maintainer: aforemny@posteo.de +author: Alexander Foremny +category: Web +build-type: Simple + +executable achat + main-is: Main.hs + hs-source-dirs: app + default-language: Haskell2010 + build-depends: + base, + clay, + haskell-halogen-core, + kan-extensions, + protolude, + row-types, + unliftio diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..2f0cce9 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QualifiedDo #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +module Main where + +import Clay qualified as C +import DOM.HTML.Indexed qualified as I +import Data.Functor.Coyoneda +import Data.NT +import Data.Row +import Halogen as H +import Halogen.Component.Debounced +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Layout as L +import Halogen.HTML.Layout.BoxLayout +import Halogen.HTML.Layout.GridBagLayout +import Halogen.HTML.Properties as HP +import Halogen.Subscription qualified as HS +import Halogen.VDom.DOM.Monad +import Protolude hiding (log) +import UnliftIO (MonadUnliftIO) + +#if defined(javascript_HOST_ARCH) +import Halogen.IO.Util as HA +import Halogen.VDom.Driver (runUI) +#endif + +attachComponent :: IO (HalogenSocket Query Int IO) +logStr :: Text -> IO () + +#if defined(javascript_HOST_ARCH) +attachComponent = + HA.awaitBody >>= runUI component () +logStr = log +#else +attachComponent = panic "This module can only be run on JavaScript" +logStr = putStrLn +#endif + +main :: IO () +main = do + HalogenSocket {messages} <- attachComponent + + void $ HS.subscribe messages $ \st -> + logStr $ "State changed: " <> show st + +{- +forever $ do + threadDelay 5_000_000 + void $ query (IncrementQ ()) + threadDelay 5_000_000 + void $ query (DecrementQ ()) + -} + +data Action = Increment Int | Decrement Int | Init + +type Slots = ("debounced" .== H.Slot VoidF () ()) + +data Query a = IncrementQ a | DecrementQ a + +component :: forall m. (MonadDOM m, MonadUnliftIO m) => H.Component Query () Int m +component = + H.mkComponent $ + H.ComponentSpec + { initialState, + render, + eval = H.mkEval $ H.defaultEval {handleAction, handleQuery, initialize = Just Init} + } + where + initialState _ = pure 0 + + render :: (MonadDOM m, MonadUnliftIO m) => Int -> H.ComponentHTML Action Slots m + render state = + L.runLayoutM (defGridBagSettings {rows = 3, cols = 3}) $ L.do + L.with (GridBagLayoutConstraints 1 1 2 2) $ L.runLayoutM Vertical $ L.do + HH.button [HE.onClick $ const $ Decrement 1] [HH.text "-"] + L.if_ (state > 5) $ HH.button [HE.onClick $ const $ Decrement 2] [HH.text "--"] + HH.div_ [HH.text $ show state] + HH.button [HE.onClick $ const $ Increment 1] [HH.text "+"] + L.if_ (state > 5) $ HH.button [HE.onClick $ const $ Increment 2] [HH.text "++"] + slot_ "debounced" () debComp () + HH.div_ [HH.text "Test sentinel element"] + L.end + + L.with (GridBagLayoutConstraints 3 3 1 1) $ + HH.div [HP.style $ C.border (C.px 2) C.solid C.black] [HH.text "Banner!"] + + L.end + + handleQuery = \case + IncrementQ cb -> do + modify (+ 1) + get >>= H.raise + pure $ Just cb + DecrementQ cb -> do + modify (subtract 1) + get >>= H.raise + pure $ Just cb + + handleAction = \case + Init -> + lift $ log "Initialized" + Increment n -> do + modify (+ n) + get >>= H.raise + Decrement n -> do + modify (subtract n) + get >>= H.raise + +--------------------------------------- + +newtype DebChanged = DebChanged Text + +debComp :: (MonadDOM m, MonadUnliftIO m) => Component VoidF () () m +debComp = unsafeMkDebouncedComponent 0.5 $ ComponentSpec {initialState, render, eval} + where + initialState _ = pure "" + + render txt = runLayoutM Vertical $ L.do + HH.div_ [HH.text "The text below is debounced"] + HH.div_ [HH.text $ "Input content: " <> txt] + HH.input + [ HP.type_ I.InputText, + HP.value txt, + HP.style $ C.width C.auto, + HE.onInputValueChange $ Just . DebChanged + ] + L.end + + eval = NT $ \case + Initialize a -> pure a + Finalize a -> pure a + Receive _i a -> pure a + Action (DebChanged str) a -> + put str $> a + Query (Coyoneda _req _fct) _f -> panic "Void2" diff --git a/app/index.html b/app/index.html new file mode 100644 index 0000000..a8e9c48 --- /dev/null +++ b/app/index.html @@ -0,0 +1,11 @@ +<!DOCTYPE html> +<html> + <head> + <meta charset="utf-8"> + <link rel='stylesheet' href="base.css" /> + <link rel='stylesheet' href="index.css" /> + </head> + <body> + <script src='all.js'></script> + </body> +</html> diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..4a0bae6 --- /dev/null +++ b/cabal.project @@ -0,0 +1,3 @@ +packages: . +with-compiler: javascript-unknown-ghcjs-ghc +with-hc-pkg: javascript-unknown-ghcjs-ghc-pkg diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..9c7a8a1 --- /dev/null +++ b/default.nix @@ -0,0 +1,27 @@ +{ pkgs ? import sources.nixpkgs { + overlays = [ + (import ./pkgs { inherit (pkgs.haskell) lib; }) + ]; + } +, sources ? import ./nix/sources.nix +}: +let + ghc = "ghc910"; + haskellPackages = pkgs.pkgsCross.ghcjs.haskell.packages.${ghc}; +in +rec { + inherit haskellPackages; + inherit (haskellPackages) achat; + shell = haskellPackages.shellFor { + packages = _: [ + haskellPackages.achat + ]; + nativeBuildInputs = [ + pkgs.haskell.packages.${ghc}.cabal-install + pkgs.haskell.packages.${ghc}.ormolu + ]; + shellHook = '' + export EM_CACHE="${toString ./.}/.emcache" # nixos/nixpkgs#282509 + ''; + }; +} diff --git a/nix/sources.json b/nix/sources.json new file mode 100644 index 0000000..57e75d7 --- /dev/null +++ b/nix/sources.json @@ -0,0 +1,26 @@ +{ + "haskell-halogen": { + "branch": "master", + "description": "Port of purescript-halogen to Haskell", + "homepage": null, + "owner": "Swordlash", + "repo": "haskell-halogen", + "rev": "0db1410e5bf2a383148fa067ae46a986a87c30c4", + "sha256": "0zrnixngfighngza2y3ps8pj0v7pdaflspiyi7742k691q17vbg8", + "type": "tarball", + "url": "https://github.com/Swordlash/haskell-halogen/archive/0db1410e5bf2a383148fa067ae46a986a87c30c4.tar.gz", + "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz" + }, + "nixpkgs": { + "branch": "nixpkgs-unstable", + "description": "Nix Packages collection", + "homepage": null, + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "632f04521e847173c54fa72973ec6c39a371211c", + "sha256": "16l9l6jbx2xy751p2nbz14fd9qgk9qsns38pihr5g12fk7361fsi", + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/632f04521e847173c54fa72973ec6c39a371211c.tar.gz", + "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz" + } +} diff --git a/nix/sources.nix b/nix/sources.nix new file mode 100644 index 0000000..fe3dadf --- /dev/null +++ b/nix/sources.nix @@ -0,0 +1,198 @@ +# This file has been generated by Niv. + +let + + # + # The fetchers. fetch_<type> fetches specs of type <type>. + # + + fetch_file = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in + if spec.builtin or true then + builtins_fetchurl { inherit (spec) url sha256; name = name'; } + else + pkgs.fetchurl { inherit (spec) url sha256; name = name'; }; + + fetch_tarball = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in + if spec.builtin or true then + builtins_fetchTarball { name = name'; inherit (spec) url sha256; } + else + pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; + + fetch_git = name: spec: + let + ref = + spec.ref or ( + if spec ? branch then "refs/heads/${spec.branch}" else + if spec ? tag then "refs/tags/${spec.tag}" else + abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!" + ); + submodules = spec.submodules or false; + submoduleArg = + let + nixSupportsSubmodules = builtins.compareVersions builtins.nixVersion "2.4" >= 0; + emptyArgWithWarning = + if submodules + then + builtins.trace + ( + "The niv input \"${name}\" uses submodules " + + "but your nix's (${builtins.nixVersion}) builtins.fetchGit " + + "does not support them" + ) + { } + else { }; + in + if nixSupportsSubmodules + then { inherit submodules; } + else emptyArgWithWarning; + in + builtins.fetchGit + ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg); + + fetch_local = spec: spec.path; + + fetch_builtin-tarball = name: throw + ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=tarball -a builtin=true''; + + fetch_builtin-url = name: throw + ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=file -a builtin=true''; + + # + # Various helpers + # + + # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695 + sanitizeName = name: + ( + concatMapStrings (s: if builtins.isList s then "-" else s) + ( + builtins.split "[^[:alnum:]+._?=-]+" + ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name) + ) + ); + + # The set of packages used when specs are fetched using non-builtins. + mkPkgs = sources: system: + let + sourcesNixpkgs = + import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; }; + hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; + hasThisAsNixpkgsPath = <nixpkgs> == ./.; + in + if builtins.hasAttr "nixpkgs" sources + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import <nixpkgs> { } + else + abort + '' + Please specify either <nixpkgs> (through -I or NIX_PATH=nixpkgs=...) or + add a package called "nixpkgs" to your sources.json. + ''; + + # The actual fetching function. + fetch = pkgs: name: spec: + + if ! builtins.hasAttr "type" spec then + abort "ERROR: niv spec ${name} does not have a 'type' attribute" + else if spec.type == "file" then fetch_file pkgs name spec + else if spec.type == "tarball" then fetch_tarball pkgs name spec + else if spec.type == "git" then fetch_git name spec + else if spec.type == "local" then fetch_local spec + else if spec.type == "builtin-tarball" then fetch_builtin-tarball name + else if spec.type == "builtin-url" then fetch_builtin-url name + else + abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}"; + + # If the environment variable NIV_OVERRIDE_${name} is set, then use + # the path directly as opposed to the fetched source. + replace = name: drv: + let + saneName = stringAsChars (c: if (builtins.match "[a-zA-Z0-9]" c) == null then "_" else c) name; + ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}"; + in + if ersatz == "" then drv else + # this turns the string into an actual Nix path (for both absolute and + # relative paths) + if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}"; + + # Ports of functions for older nix versions + + # a Nix version of mapAttrs if the built-in doesn't exist + mapAttrs = builtins.mapAttrs or ( + f: set: with builtins; + listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)) + ); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295 + range = first: last: if first > last then [ ] else builtins.genList (n: first + n) (last - first + 1); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257 + stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1)); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269 + stringAsChars = f: s: concatStrings (map f (stringToCharacters s)); + concatMapStrings = f: list: concatStrings (map f list); + concatStrings = builtins.concatStringsSep ""; + + # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331 + optionalAttrs = cond: as: if cond then as else { }; + + # fetchTarball version that is compatible between all the versions of Nix + builtins_fetchTarball = { url, name ? null, sha256 }@attrs: + let + inherit (builtins) lessThan nixVersion fetchTarball; + in + if lessThan nixVersion "1.12" then + fetchTarball ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchTarball attrs; + + # fetchurl version that is compatible between all the versions of Nix + builtins_fetchurl = { url, name ? null, sha256 }@attrs: + let + inherit (builtins) lessThan nixVersion fetchurl; + in + if lessThan nixVersion "1.12" then + fetchurl ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchurl attrs; + + # Create the final "sources" from the config + mkSources = config: + mapAttrs + ( + name: spec: + if builtins.hasAttr "outPath" spec + then + abort + "The values in sources.json should not have an 'outPath' attribute" + else + spec // { outPath = replace name (fetch config.pkgs name spec); } + ) + config.sources; + + # The "config" used by the fetchers + mkConfig = + { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null + , sources ? if sourcesFile == null then { } else builtins.fromJSON (builtins.readFile sourcesFile) + , system ? builtins.currentSystem + , pkgs ? mkPkgs sources system + }: rec { + # The sources, i.e. the attribute set of spec name to spec + inherit sources; + + # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers + inherit pkgs; + }; + +in +mkSources (mkConfig { }) // { __functor = _: settings: mkSources (mkConfig settings); } diff --git a/pkgs/default.nix b/pkgs/default.nix new file mode 100644 index 0000000..b46e6f8 --- /dev/null +++ b/pkgs/default.nix @@ -0,0 +1,23 @@ +{ lib +, sources ? import ../nix/sources.nix +, ... +}: +(self: super: { + haskell = super.haskell // { + packageOverrides = self: super: { + achat = (self.callCabal2nix "achat" ../. { }).overrideAttrs (_: { + postInstall = '' + mkdir -p $out/share + cp -a ./dist/build/achat/achat.jsexe $out/share + ''; + }); + haskell-halogen-core = lib.dontCheck (self.callCabal2nix "haskell-halogen-core" sources.haskell-halogen { }); + protolude = lib.dontHaddock ( + lib.appendConfigureFlags (lib.doJailbreak super.protolude) [ + "--ghc-option=-fno-safe-haskell" + "--ghc-option=-fno-warn-x-partial" + ]); + clay = self.callHackage "clay" "0.15.0" { }; + }; + }; +}) diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..a6bdf20 --- /dev/null +++ b/shell.nix @@ -0,0 +1 @@ +(import ./. { }).shell |