init

.envrc

@@ -0,0 +1 @@
+use nix

.gitignore

@@ -0,0 +1 @@
+/dist-newstyle

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2024, 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:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * 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.
+
+    * Neither the name of Alexander Foremny nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+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.

acms.cabal

@@ -0,0 +1,38 @@
+cabal-version: 3.4
+name:          acms
+version:       0.1.0.0
+license:       BSD-3-Clause
+license-file:  LICENSE
+maintainer:    aforemny@posteo.de
+author:        Alexander Foremny
+build-type:    Simple
+
+executable acms
+    main-is:            Main.hs
+    hs-source-dirs:     app
+    default-language:   GHC2021
+    default-extensions:
+        BlockArguments LambdaCase OverloadedStrings ViewPatterns
+        OverloadedRecordDot NoFieldSelectors
+
+    ghc-options:        -Wall -threaded
+    build-depends:
+        aeson,
+        astore,
+        attoparsec,
+        autotypes,
+        base,
+        bytestring,
+        containers,
+        directory,
+        filepath,
+        gitlib,
+        gitlib-libgit2,
+        hlibgit2,
+        http-types,
+        mtl,
+        optparse-applicative,
+        tagged,
+        utf8-string,
+        wai,
+        warp

app/Main.hs

@@ -0,0 +1,132 @@
+module Main where
+
+import AutoTypes qualified as U
+import AutoTypes.Unify qualified as U
+import Control.Applicative ((<**>))
+import Control.Monad
+import Control.Monad.Trans (liftIO)
+import Data.Aeson qualified as J
+import Data.Attoparsec.Char8 as P
+import Data.ByteString.Char8 qualified as B
+import Data.ByteString.Lazy.Char8 qualified as LB
+import Data.ByteString.Lazy.UTF8 qualified as LB
+import Data.ByteString.UTF8 qualified as B
+import Data.List
+import Data.Map qualified as M
+import Data.String (IsString (fromString))
+import Data.Tagged (Tagged (..))
+import Debug.Trace
+import Git qualified as G
+import Git.Libgit2 qualified as GB
+import Network.HTTP.Types.Method qualified as W
+import Network.HTTP.Types.Status qualified as W
+import Network.Wai qualified as W
+import Network.Wai.Handler.Warp qualified as W
+import Options.Applicative qualified as A
+import System.Directory (setCurrentDirectory)
+import System.FilePath
+import Text.Printf (printf)
+
+data Args = Args
+  { cmd :: Cmd
+  }
+
+args :: A.Parser Args
+args = Args <$> cmd'
+
+data Cmd = Serve
+
+cmd' :: A.Parser Cmd
+cmd' =
+  A.hsubparser . mconcat $
+    [ A.command "serve" . A.info serveCmd $
+        A.progDesc "Run webserver"
+    ]
+
+serveCmd :: A.Parser Cmd
+serveCmd = pure Serve
+
+data Repo = Repo
+  { commits :: [Commit]
+  }
+  deriving (Show)
+
+data Commit = Commit
+  { id :: G.CommitOid GB.LgRepo,
+    collections :: [Collection]
+  }
+  deriving (Show)
+
+data Collection = Collection
+  { path :: FilePath,
+    files :: [FilePath],
+    schema :: Schema
+  }
+  deriving (Show)
+
+data Schema = Schema {unSchema :: J.Value}
+  deriving (Show)
+
+instance J.ToJSON Schema where
+  toJSON = J.toJSON . (.unSchema)
+
+fromAutoTypes :: String -> U.T -> Schema
+fromAutoTypes path (U.Object ps) =
+  Schema $
+    J.object
+      [ ("$schema", J.toJSON @String "https://json-schema.org/draft/2020-12/schema"),
+        ("$id", J.toJSON @String (path <> ".schema.json")),
+        ("title", J.toJSON @String path),
+        ("type", J.toJSON @String "object"),
+        ("properties", J.toJSON (M.mapWithKey toProperty ps))
+      ]
+  where
+    toProperty k (U.Scalar "string") = "string" :: String
+
+main :: IO ()
+main = do
+  setCurrentDirectory "./blog"
+  let root = "."
+      ref = "HEAD"
+  repo <- G.openRepository GB.lgFactory G.defaultRepositoryOptions {G.repoPath = root}
+  repo <- G.runRepository GB.lgFactory repo do
+    Just cid <- fmap Tagged <$> G.resolveReference ref
+    c <- G.lookupCommit cid
+    cs <- mapM G.lookupCommit =<< G.listCommits Nothing cid
+    let showCommit c = G.commitLog c
+    fmap Repo . forM cs $ \c -> do
+      let cid = G.commitOid c
+      let tid = G.commitTree c
+      t <- G.lookupTree tid
+      fs <-
+        filter ((== ".json") . takeExtension)
+          . map B.toString
+          . map fst
+          <$> G.listTreeEntries t
+      let cls = M.toList (M.unionsWith (++) (map (\f -> M.singleton (takeDirectory f) [f]) fs))
+      colls <- forM cls $ \(path, (file : files)) -> do
+        schema <-
+          fmap (fromAutoTypes path) . liftIO $ -- TODO read from HEAD
+            U.autoTypes file files
+        pure $ Collection path files schema
+      pure (Commit cid colls)
+  A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
+    Args {cmd = Serve} -> do
+      W.runEnv 8080 $ \req respond -> do
+        case P.parseOnly routeP (W.rawPathInfo req) of
+          Right (SchemaJson path) -> do
+            let [c] = filter ((== path) . (.path)) (head repo.commits).collections
+            respond $ W.responseLBS W.status200 [] (J.encode c.schema)
+          (Debug.Trace.traceShowId -> !_) ->
+            respond $ W.responseLBS W.status200 [] "OK"
+
+data Route
+  = SchemaJson String
+  deriving (Show)
+
+routeP :: P.Parser Route
+routeP =
+  ( SchemaJson
+      <$> (P.string "/" *> P.manyTill P.anyChar (P.string ".schema.json"))
+  )
+    <* P.endOfInput

autotypes/.gitignore

@@ -0,0 +1 @@
+/dist-newstyle

autotypes/app/Main.hs

@@ -0,0 +1,27 @@
+module Main where
+
+import AutoTypes.Unify as U
+import Data.Aeson (Value, decodeFileStrict', encode)
+import qualified Data.ByteString.Lazy as B
+import System.Environment (getArgs)
+import System.FilePath (takeFileName)
+
+main :: IO ()
+main = do
+  filePaths <- getArgs
+  types <-
+    mapM
+      ( \filePath -> do
+          Just value <- decodeFileStrict' filePath
+          pure (U.fromJson value)
+      )
+      filePaths
+  B.putStr
+    ( encode
+        ( head
+            ( foldr1
+                (\ls rs -> (concat [unify1 l r | l <- ls, r <- rs]))
+                (map (: []) types)
+            )
+        )
+    )

autotypes/autotypes.cabal

@@ -0,0 +1,54 @@
+cabal-version:      2.4
+name:               autotypes
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             Alexander Foremny
+maintainer:         aforemny@posteo.de
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+library
+    exposed-modules:
+      AutoTypes
+      AutoTypes.Unify
+
+    -- Modules included in this library but not exported.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:
+      aeson,
+      aeson-qq,
+      base,
+      bytestring,
+      containers,
+      filepath,
+      vector
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+executable autotypes
+  main-is: Main.hs
+  hs-source-dirs: app
+  default-language: Haskell2010
+  build-depends:
+    aeson,
+    autotypes,
+    base,
+    bytestring,
+    filepath

autotypes/default.nix

@@ -0,0 +1,16 @@
+{ mkDerivation, aeson, aeson-qq, base, bytestring, containers
+, filepath, lib, vector
+}:
+mkDerivation {
+  pname = "autotypes";
+  version = "0.1.0.0";
+  src = ./.;
+  isLibrary = true;
+  isExecutable = true;
+  libraryHaskellDepends = [
+    aeson aeson-qq base bytestring containers filepath vector
+  ];
+  executableHaskellDepends = [ aeson base bytestring filepath ];
+  license = "unknown";
+  mainProgram = "autotypes";
+}

autotypes/src/AutoTypes.hs

@@ -0,0 +1,25 @@
+module AutoTypes
+  ( autoTypes,
+    autoTypes',
+  )
+where
+
+import Debug.Trace
+import qualified AutoTypes.Unify as U
+import Data.Aeson (Value, decodeFileStrict', encode)
+import Data.Maybe (fromJust)
+import System.Environment (getArgs)
+import System.FilePath (takeFileName)
+
+autoTypes :: FilePath -> [FilePath] -> IO U.T
+autoTypes fp fps = autoTypes' <$> go fp <*> mapM go (fp : fps)
+  where go = fmap fromJust . decodeFileStrict'
+
+autoTypes' :: Value -> [Value] -> U.T
+autoTypes' t' ts' =
+  let types = map U.fromJson (Debug.Trace.traceShowId (t' : ts'))
+   in head
+        ( foldr1
+            (\ls rs -> (concat [U.unify1 l r | l <- ls, r <- rs]))
+            (map (: []) types)
+        )

autotypes/src/AutoTypes/Unify.hs

@@ -0,0 +1,251 @@
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module AutoTypes.Unify
+  ( T (..),
+    toString,
+    fromJson,
+    unify1,
+  )
+where
+
+import Control.Arrow
+import Control.Exception (Exception, throw)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Key as K
+import qualified Data.Aeson.KeyMap as KM
+import Data.Aeson.QQ
+import Data.List (intercalate, nub)
+import Data.Map (Map)
+import qualified Data.Map as M
+import qualified Data.Map.Merge.Lazy as M
+import qualified Data.Vector as V
+import Debug.Trace
+import Prelude hiding (null)
+
+data T
+  = List (Maybe T)
+  | Object (Map String T)
+  | Option (Maybe T)
+  | Scalar String
+  | Union [T]
+  deriving (Eq, Show)
+
+instance A.ToJSON T where
+  toJSON (List t) = A.toJSON t
+  toJSON (Object ts) = A.toJSON ts
+  toJSON (Option t) = A.toJSON t
+  toJSON (Scalar s) = A.toJSON s
+  toJSON (Union ts) = A.toJSON ts
+
+toString :: T -> String
+toString = intercalate "\n" . map (\(n, s) -> indent n s) . toString_ 0
+
+toString_ :: Int -> T -> [(Int, String)]
+toString_ n (Object kvs) =
+  concat
+    [ [(n, "{")],
+      concat . M.elems $
+        M.mapWithKey (\s t -> (n + 1, s) : toString_ (n + 2) t) kvs,
+      [(n, "}")]
+    ]
+toString_ n (Scalar s) = [(n, s)]
+toString_ n (Union ts) = concatMap (toString_ n) ts
+toString_ n (Option Nothing) = [(n, "null")]
+toString_ n (Option (Just t)) = map (second (++ "?")) (toString_ n t)
+
+indent n = (++) (replicate (4 * n) ' ')
+
+union :: [T] -> T
+union ts =
+  case ts of
+    [t] -> t
+    ts -> Union ts
+
+unify1 :: T -> T -> [T]
+unify1 (Scalar n) (Scalar m)
+  | n == m = [Scalar n]
+  | otherwise = [union [Scalar n, Scalar m]]
+unify1 l@(Object ls) r@(Object rs) =
+  let os =
+        ( map Object . traverse id $
+            let f _ (l@(Option _)) = [l]
+                f _ l = [Option (Just l)]
+             in M.merge
+                  (M.mapMissing f)
+                  (M.mapMissing f)
+                  (M.zipWithMatched (\_ l r -> unify1 l r))
+                  ls
+                  rs
+        )
+   in os
+        ++ ( if l `subst` r || r `subst` l
+               then []
+               else [union [l, r]]
+           )
+unify1 (Option Nothing) (Option Nothing) = [Option Nothing]
+unify1 (Option (Just l)) (Option Nothing) = [Option (Just l)]
+unify1 (Option Nothing) (Option (Just r)) = [Option (Just r)]
+unify1 (Option (Just l)) (Option (Just r)) = map (Option . Just) (unify1 l r)
+unify1 (Option Nothing) r = [Option (Just r)]
+unify1 (List Nothing) (List Nothing) = [List Nothing]
+unify1 (List Nothing) (List (Just t)) = [List (Just t)]
+unify1 (List (Just t)) (List Nothing) = [List (Just t)]
+unify1 (List (Just l)) (List (Just r)) =
+  if l == r || r `subst` l
+    then [List (Just l)]
+    else
+      if l `subst` r
+        then [List (Just r)]
+        else [List (Just (union [l, r]))]
+unify1 l (Option Nothing) = [Option (Just l)]
+unify1 l (Option (Just r)) = map (Option . Just) (unify1 l r)
+unify1 (Option (Just l)) r = map (Option . Just) (unify1 l r)
+unify1 (Union ls) (Union rs) = [union (ls ++ rs)]
+unify1 (Union ls) r = [union (ls ++ [r])]
+unify1 l (Union rs) = [union ([l] ++ rs)]
+unify1 l r = [union [l, r]]
+
+subst :: T -> T -> Bool
+subst (Object l) (Object r) =
+  and
+    ( map
+        ( \(k, t) -> case (t, M.lookup k r) of
+            (t, Just t') -> t `subst` t'
+            _ -> False
+        )
+        (M.toList l)
+    )
+subst (Option Nothing) (Option _) = True
+subst l (Option Nothing) = True
+subst (Option (Just l)) (Option (Just r)) = l `subst` r
+subst l (Option (Just r)) = l `subst` r
+subst l r = l == r
+
+lims :: [T] -> [T]
+lims ts = nub [t | t <- ts, all (\t' -> not (t `subst` t') || t' == t) ts]
+
+unify l r =
+  let s =
+        unlines
+          ( [ toString l ++ "," ++ toString r,
+              "---"
+            ]
+              ++ map toString t
+          )
+      t = unify1 l r
+   in Debug.Trace.trace s t
+
+{-
+unify :: T -> T -> Either (T, T) T
+unify (Scalar n) (Scalar m)
+  | n == m = Right (Scalar n)
+  | otherwise = Left (Scalar n, Scalar m)
+unify (Object ls) (Object rs) =
+  let f _ (l@(Option _)) = Right l
+      f _ l = Right (Option (Just l))
+   in case M.merge
+        (M.mapMissing f)
+        (M.mapMissing f)
+        (M.zipWithMatched (\_ l r -> unify l r))
+        ls
+        rs
+        & M.partition isRight
+        & ( \(rs, ls) ->
+              (M.map (fromRight undefined) rs, M.elems (M.map (fromLeft undefined) ls))
+          ) of
+        (_, e : _) -> Left e
+        (lrs, []) -> Right (Object lrs)
+unify (Option Nothing) (Option Nothing) = Right (Option Nothing)
+unify (Option (Just l)) (Option Nothing) = Right (Option (Just l))
+unify (Option Nothing) (Option (Just r)) = Right (Option (Just r))
+unify (Option (Just l)) (Option (Just r)) = Option . Just <$> unify l r
+-}
+
+object :: Map String T -> T
+object = Object
+
+list :: Maybe T -> T
+list = List
+
+string, number, bool, null :: T
+string = Scalar "string"
+number = Scalar "number"
+bool = Scalar "bool"
+null = Option Nothing
+
+data InferException = InferException [T]
+  deriving (Show)
+
+instance Exception InferException
+
+fromJson :: A.Value -> T
+fromJson (A.Object kvs) =
+  object (M.mapKeys K.toString (M.map fromJson (KM.toMap kvs)))
+fromJson t@(A.Array vs) =
+  let ts = map fromJson (V.toList vs)
+   in case nub ts of
+        [] -> list Nothing
+        [t] -> list (Just t)
+        _ -> throw (InferException ts)
+fromJson (A.String _) = string
+fromJson (A.Number _) = number
+fromJson (A.Bool _) = bool
+fromJson A.Null = null
+
+object1 =
+  [aesonQQ|{
+    "firstName": "firstName",
+    "lastName": "lastName"
+  }|]
+
+object2 =
+  [aesonQQ|{
+    "firstName": "firstName",
+    "lastName": "lastName",
+    "birthDay": null
+  }|]
+
+object3 =
+  [aesonQQ|{
+    "firstName": "firstName",
+    "lastName": "lastName",
+    "birthDay": "1990-01-01"
+  }|]
+
+object4 =
+  [aesonQQ|{
+  "firstName": "firstName"
+  }|]
+
+object5 =
+  [aesonQQ|{
+  "lastName": 42,
+  "birthDay": null
+  }|]
+
+main =
+  -- fromJson object2 =:= fromJson object3
+  -- unify (fromJson object1) (fromJson object2)
+  putStrLn
+    ( intercalate
+        "\n\n"
+        ( map
+            toString
+            ( foldr1
+                (\ls rs -> (concat [unify1 l r | l <- ls, r <- rs]))
+                ( map
+                    ((: []) . fromJson)
+                    [ object1,
+                      object2,
+                      -- object3,
+                      -- object4,
+                      object5
+                    ]
+                )
+            )
+        )
+    )
+
+-- >>= unify (fromJson object2)
+-- >>= unify (fromJson object4)

cabal.project

@@ -0,0 +1 @@
+packages: ./*.cabal autotypes/*.cabal

default.nix

@@ -0,0 +1,25 @@
+{ pkgs ? import sources.nixpkgs { }
+, sources ? import ./nix/sources.nix
+}:
+let
+  haskellPackages = pkgs.haskellPackages.override {
+    overrides = self: super: {
+      acms = self.callCabal2nix "acms" ./. { };
+      astore = self.callCabal2nix "astore" sources.json2sql { };
+      autotypes = self.callCabal2nix "autotypes" ./autotypes { };
+      json2sql = self.callCabal2nix "json2sql" sources.json2sql { };
+    };
+  };
+in
+rec {
+  inherit (haskellPackages) acms;
+  shell = haskellPackages.shellFor {
+    packages = _: [ acms haskellPackages.autotypes ];
+    buildInputs = [
+      haskellPackages.cabal-install
+      haskellPackages.ormolu
+    ];
+    withHoogle = true;
+    withHaddock = true;
+  };
+}

nix/sources.json

@@ -0,0 +1,20 @@
+{
+    "json2sql": {
+        "branch": "main",
+        "repo": "git@code.nomath.org:~/json2sql",
+        "rev": "bbe3b75bfd0767c61bcd436e843b9c785efd289f",
+        "type": "git"
+    },
+    "nixpkgs": {
+        "branch": "nixos-unstable",
+        "description": "Nix Packages collection",
+        "homepage": null,
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "6c43a3495a11e261e5f41e5d7eda2d71dae1b2fe",
+        "sha256": "16f329z831bq7l3wn1dfvbkh95l2gcggdwn6rk3cisdmv2aa3189",
+        "type": "tarball",
+        "url": "https://github.com/NixOS/nixpkgs/archive/6c43a3495a11e261e5f41e5d7eda2d71dae1b2fe.tar.gz",
+        "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
+    }
+}

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); }

shell.nix

@@ -0,0 +1 @@
+(import ./. { }).shell