From ec0ea18486ed2569808f2e511ecac52f812300b0 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Tue, 28 May 2024 22:04:34 +0200 Subject: init --- .envrc | 1 + .gitignore | 1 + LICENSE | 30 +++++ acms.cabal | 38 ++++++ app/Main.hs | 132 ++++++++++++++++++++ autotypes/.gitignore | 1 + autotypes/app/Main.hs | 27 +++++ autotypes/autotypes.cabal | 54 +++++++++ autotypes/default.nix | 16 +++ autotypes/src/AutoTypes.hs | 25 ++++ autotypes/src/AutoTypes/Unify.hs | 251 +++++++++++++++++++++++++++++++++++++++ cabal.project | 1 + default.nix | 25 ++++ nix/sources.json | 20 ++++ nix/sources.nix | 198 ++++++++++++++++++++++++++++++ shell.nix | 1 + 16 files changed, 821 insertions(+) create mode 100644 .envrc create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 acms.cabal create mode 100644 app/Main.hs create mode 100644 autotypes/.gitignore create mode 100644 autotypes/app/Main.hs create mode 100644 autotypes/autotypes.cabal create mode 100644 autotypes/default.nix create mode 100644 autotypes/src/AutoTypes.hs create mode 100644 autotypes/src/AutoTypes/Unify.hs create mode 100644 cabal.project create mode 100644 default.nix create mode 100644 nix/sources.json create mode 100644 nix/sources.nix create mode 100644 shell.nix diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..1d953f4 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use nix diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8075013 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/dist-newstyle diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..c90516a --- /dev/null +++ b/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. diff --git a/acms.cabal b/acms.cabal new file mode 100644 index 0000000..38a3bf2 --- /dev/null +++ b/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 diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..fce12b4 --- /dev/null +++ b/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 diff --git a/autotypes/.gitignore b/autotypes/.gitignore new file mode 100644 index 0000000..8075013 --- /dev/null +++ b/autotypes/.gitignore @@ -0,0 +1 @@ +/dist-newstyle diff --git a/autotypes/app/Main.hs b/autotypes/app/Main.hs new file mode 100644 index 0000000..d9fa7f4 --- /dev/null +++ b/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) + ) + ) + ) diff --git a/autotypes/autotypes.cabal b/autotypes/autotypes.cabal new file mode 100644 index 0000000..284ad0e --- /dev/null +++ b/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 diff --git a/autotypes/default.nix b/autotypes/default.nix new file mode 100644 index 0000000..93962fe --- /dev/null +++ b/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"; +} diff --git a/autotypes/src/AutoTypes.hs b/autotypes/src/AutoTypes.hs new file mode 100644 index 0000000..c5a43d1 --- /dev/null +++ b/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) + ) diff --git a/autotypes/src/AutoTypes/Unify.hs b/autotypes/src/AutoTypes/Unify.hs new file mode 100644 index 0000000..1742c3a --- /dev/null +++ b/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) diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..f641ad1 --- /dev/null +++ b/cabal.project @@ -0,0 +1 @@ +packages: ./*.cabal autotypes/*.cabal diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..060a4c7 --- /dev/null +++ b/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; + }; +} diff --git a/nix/sources.json b/nix/sources.json new file mode 100644 index 0000000..21ed699 --- /dev/null +++ b/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///archive/.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_ fetches specs of 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 = == ./.; + in + if builtins.hasAttr "nixpkgs" sources + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import { } + else + abort + '' + Please specify either (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/shell.nix b/shell.nix new file mode 100644 index 0000000..a6bdf20 --- /dev/null +++ b/shell.nix @@ -0,0 +1 @@ +(import ./. { }).shell -- cgit v1.2.3