{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Niv.Sources where

import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Extended as Aeson
import qualified Data.Aeson.KeyMap as KM
import Data.Bifunctor (first)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.Digest.Pure.MD5 as MD5
import Data.FileEmbed (embedFile)
import qualified Data.HashMap.Strict as HMS
import Data.Hashable (Hashable)
import Data.List
import Data.String.QQ (s)
import qualified Data.Text as T
import Data.Text.Extended
import Niv.Logger
import Niv.Update
import qualified System.Directory as Dir
import System.FilePath ((</>))
import UnliftIO

-------------------------------------------------------------------------------
-- sources.json related
-------------------------------------------------------------------------------

-- | Where to find the sources.json
data FindSourcesJson
  = -- | use the default (nix/sources.json)
    Auto
  | -- | use the specified file path
    AtPath FilePath

data SourcesError
  = SourcesDoesntExist
  | SourceIsntJSON
  | SpecIsntAMap

newtype Sources = Sources
  {Sources -> HashMap PackageName PackageSpec
unSources :: HMS.HashMap PackageName PackageSpec}
  deriving newtype (Value -> Parser [Sources]
Value -> Parser Sources
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Sources]
$cparseJSONList :: Value -> Parser [Sources]
parseJSON :: Value -> Parser Sources
$cparseJSON :: Value -> Parser Sources
FromJSON, [Sources] -> Encoding
[Sources] -> Value
Sources -> Encoding
Sources -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Sources] -> Encoding
$ctoEncodingList :: [Sources] -> Encoding
toJSONList :: [Sources] -> Value
$ctoJSONList :: [Sources] -> Value
toEncoding :: Sources -> Encoding
$ctoEncoding :: Sources -> Encoding
toJSON :: Sources -> Value
$ctoJSON :: Sources -> Value
ToJSON)

getSourcesEither :: FindSourcesJson -> IO (Either SourcesError Sources)
getSourcesEither :: FindSourcesJson -> IO (Either SourcesError Sources)
getSourcesEither FindSourcesJson
fsj = do
  FilePath -> IO Bool
Dir.doesFileExist (FindSourcesJson -> FilePath
pathNixSourcesJson FindSourcesJson
fsj) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SourcesError
SourcesDoesntExist
    Bool
True ->
      forall a. FromJSON a => FilePath -> IO (Maybe a)
Aeson.decodeFileStrict (FindSourcesJson -> FilePath
pathNixSourcesJson FindSourcesJson
fsj) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Value
value -> case Value -> Maybe Sources
valueToSources Value
value of
          Maybe Sources
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SourcesError
SpecIsntAMap
          Just Sources
srcs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Sources
srcs
        Maybe Value
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SourcesError
SourceIsntJSON
  where
    valueToSources :: Aeson.Value -> Maybe Sources
    valueToSources :: Value -> Maybe Sources
valueToSources = \case
      Aeson.Object Object
obj ->
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashMap PackageName PackageSpec -> Sources
Sources forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys Text -> PackageName
PackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> HashMap Text v
KM.toHashMapText) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
            ( \case
                Aeson.Object Object
obj' -> forall a. a -> Maybe a
Just (Object -> PackageSpec
PackageSpec Object
obj')
                Value
_ -> forall a. Maybe a
Nothing
            )
            Object
obj
      Value
_ -> forall a. Maybe a
Nothing
    mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HMS.HashMap k1 v -> HMS.HashMap k2 v
    mapKeys :: forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys k1 -> k2
f = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first k1 -> k2
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HMS.toList

getSources :: FindSourcesJson -> IO Sources
getSources :: FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj = do
  IO ()
warnIfOutdated
  FindSourcesJson -> IO (Either SourcesError Sources)
getSourcesEither FindSourcesJson
fsj
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      ( \case
          SourcesError
SourcesDoesntExist -> (forall a. FindSourcesJson -> IO a
abortSourcesDoesntExist FindSourcesJson
fsj)
          SourcesError
SourceIsntJSON -> (forall a. FindSourcesJson -> IO a
abortSourcesIsntJSON FindSourcesJson
fsj)
          SourcesError
SpecIsntAMap -> (forall a. FindSourcesJson -> IO a
abortSpecIsntAMap FindSourcesJson
fsj)
      )
      forall (f :: * -> *) a. Applicative f => a -> f a
pure

setSources :: FindSourcesJson -> Sources -> IO ()
setSources :: FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj Sources
sources = forall a. ToJSON a => FilePath -> a -> IO ()
Aeson.encodeFilePretty (FindSourcesJson -> FilePath
pathNixSourcesJson FindSourcesJson
fsj) Sources
sources

newtype PackageName = PackageName {PackageName -> Text
unPackageName :: T.Text}
  deriving newtype (PackageName -> PackageName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageName -> PackageName -> Bool
$c/= :: PackageName -> PackageName -> Bool
== :: PackageName -> PackageName -> Bool
$c== :: PackageName -> PackageName -> Bool
Eq, Eq PackageName
Int -> PackageName -> Int
PackageName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PackageName -> Int
$chash :: PackageName -> Int
hashWithSalt :: Int -> PackageName -> Int
$chashWithSalt :: Int -> PackageName -> Int
Hashable, FromJSONKeyFunction [PackageName]
FromJSONKeyFunction PackageName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PackageName]
$cfromJSONKeyList :: FromJSONKeyFunction [PackageName]
fromJSONKey :: FromJSONKeyFunction PackageName
$cfromJSONKey :: FromJSONKeyFunction PackageName
FromJSONKey, ToJSONKeyFunction [PackageName]
ToJSONKeyFunction PackageName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PackageName]
$ctoJSONKeyList :: ToJSONKeyFunction [PackageName]
toJSONKey :: ToJSONKeyFunction PackageName
$ctoJSONKey :: ToJSONKeyFunction PackageName
ToJSONKey, Int -> PackageName -> ShowS
[PackageName] -> ShowS
PackageName -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PackageName] -> ShowS
$cshowList :: [PackageName] -> ShowS
show :: PackageName -> FilePath
$cshow :: PackageName -> FilePath
showsPrec :: Int -> PackageName -> ShowS
$cshowsPrec :: Int -> PackageName -> ShowS
Show)

newtype PackageSpec = PackageSpec {PackageSpec -> Object
unPackageSpec :: Aeson.Object}
  deriving newtype (Value -> Parser [PackageSpec]
Value -> Parser PackageSpec
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PackageSpec]
$cparseJSONList :: Value -> Parser [PackageSpec]
parseJSON :: Value -> Parser PackageSpec
$cparseJSON :: Value -> Parser PackageSpec
FromJSON, [PackageSpec] -> Encoding
[PackageSpec] -> Value
PackageSpec -> Encoding
PackageSpec -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PackageSpec] -> Encoding
$ctoEncodingList :: [PackageSpec] -> Encoding
toJSONList :: [PackageSpec] -> Value
$ctoJSONList :: [PackageSpec] -> Value
toEncoding :: PackageSpec -> Encoding
$ctoEncoding :: PackageSpec -> Encoding
toJSON :: PackageSpec -> Value
$ctoJSON :: PackageSpec -> Value
ToJSON, Int -> PackageSpec -> ShowS
[PackageSpec] -> ShowS
PackageSpec -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PackageSpec] -> ShowS
$cshowList :: [PackageSpec] -> ShowS
show :: PackageSpec -> FilePath
$cshow :: PackageSpec -> FilePath
showsPrec :: Int -> PackageSpec -> ShowS
$cshowsPrec :: Int -> PackageSpec -> ShowS
Show, NonEmpty PackageSpec -> PackageSpec
PackageSpec -> PackageSpec -> PackageSpec
forall b. Integral b => b -> PackageSpec -> PackageSpec
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> PackageSpec -> PackageSpec
$cstimes :: forall b. Integral b => b -> PackageSpec -> PackageSpec
sconcat :: NonEmpty PackageSpec -> PackageSpec
$csconcat :: NonEmpty PackageSpec -> PackageSpec
<> :: PackageSpec -> PackageSpec -> PackageSpec
$c<> :: PackageSpec -> PackageSpec -> PackageSpec
Semigroup, Semigroup PackageSpec
PackageSpec
[PackageSpec] -> PackageSpec
PackageSpec -> PackageSpec -> PackageSpec
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PackageSpec] -> PackageSpec
$cmconcat :: [PackageSpec] -> PackageSpec
mappend :: PackageSpec -> PackageSpec -> PackageSpec
$cmappend :: PackageSpec -> PackageSpec -> PackageSpec
mempty :: PackageSpec
$cmempty :: PackageSpec
Monoid)

-- | Simply discards the 'Freedom'
attrsToSpec :: Attrs -> PackageSpec
attrsToSpec :: Attrs -> PackageSpec
attrsToSpec = Object -> PackageSpec
PackageSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd

-- | @nix/sources.json@ or pointed at by 'FindSourcesJson'
pathNixSourcesJson :: FindSourcesJson -> FilePath
pathNixSourcesJson :: FindSourcesJson -> FilePath
pathNixSourcesJson = \case
  FindSourcesJson
Auto -> FilePath
"nix" FilePath -> ShowS
</> FilePath
"sources.json"
  AtPath FilePath
f -> FilePath
f

--
-- ABORT messages
--

abortSourcesDoesntExist :: FindSourcesJson -> IO a
abortSourcesDoesntExist :: forall a. FindSourcesJson -> IO a
abortSourcesDoesntExist FindSourcesJson
fsj = forall (io :: * -> *) a. MonadIO io => Text -> io a
abort forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text
line1, Text
line2]
  where
    line1 :: Text
line1 = Text
"Cannot use " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FindSourcesJson -> FilePath
pathNixSourcesJson FindSourcesJson
fsj)
    line2 :: Text
line2 =
      [s|
The sources file does not exist! You may need to run 'niv init'.
|]

abortSourcesIsntJSON :: FindSourcesJson -> IO a
abortSourcesIsntJSON :: forall a. FindSourcesJson -> IO a
abortSourcesIsntJSON FindSourcesJson
fsj = forall (io :: * -> *) a. MonadIO io => Text -> io a
abort forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text
line1, Text
line2]
  where
    line1 :: Text
line1 = Text
"Cannot use " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FindSourcesJson -> FilePath
pathNixSourcesJson FindSourcesJson
fsj)
    line2 :: Text
line2 = Text
"The sources file should be JSON."

abortSpecIsntAMap :: FindSourcesJson -> IO a
abortSpecIsntAMap :: forall a. FindSourcesJson -> IO a
abortSpecIsntAMap FindSourcesJson
fsj = forall (io :: * -> *) a. MonadIO io => Text -> io a
abort forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text
line1, Text
line2]
  where
    line1 :: Text
line1 = Text
"Cannot use " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FindSourcesJson -> FilePath
pathNixSourcesJson FindSourcesJson
fsj)
    line2 :: Text
line2 =
      [s|
The package specifications in the sources file should be JSON maps from
attribute name to attribute value, e.g.:
  { "nixpkgs": { "foo": "bar" } }
|]

-------------------------------------------------------------------------------
-- sources.nix related
-------------------------------------------------------------------------------

-- | All the released versions of nix/sources.nix
data SourcesNixVersion
  = V1
  | V2
  | V3
  | V4
  | V5
  | V6
  | V7
  | V8
  | V9
  | V10
  | V11
  | V12
  | V13
  | V14
  | V15
  | V16
  | V17
  | -- prettify derivation name
    -- add 'local' type of sources
    V18
  | -- add NIV_OVERRIDE_{name}
    V19
  | -- can be imported when there's no sources.json
    V20
  | -- Use the source name in fetchurl
    V21
  | -- Stop setting `ref` and use `branch` and `tag` in sources
    V22
  | -- Allow to pass custom system to bootstrap niv in pure mode
    V23
  | -- Fix NIV_OVERRIDE_{name} for sandbox
    V24
  | -- Add the ability to pass submodules to fetchGit
    V25
  | -- formatting fix
    V26
  | -- Support submodules for git repos
    V27
  | -- formatting fix
    -- Apply statix suggestions
    V28
  deriving stock (SourcesNixVersion
forall a. a -> a -> Bounded a
maxBound :: SourcesNixVersion
$cmaxBound :: SourcesNixVersion
minBound :: SourcesNixVersion
$cminBound :: SourcesNixVersion
Bounded, Int -> SourcesNixVersion
SourcesNixVersion -> Int
SourcesNixVersion -> [SourcesNixVersion]
SourcesNixVersion -> SourcesNixVersion
SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
SourcesNixVersion
-> SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SourcesNixVersion
-> SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
$cenumFromThenTo :: SourcesNixVersion
-> SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
enumFromTo :: SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
$cenumFromTo :: SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
enumFromThen :: SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
$cenumFromThen :: SourcesNixVersion -> SourcesNixVersion -> [SourcesNixVersion]
enumFrom :: SourcesNixVersion -> [SourcesNixVersion]
$cenumFrom :: SourcesNixVersion -> [SourcesNixVersion]
fromEnum :: SourcesNixVersion -> Int
$cfromEnum :: SourcesNixVersion -> Int
toEnum :: Int -> SourcesNixVersion
$ctoEnum :: Int -> SourcesNixVersion
pred :: SourcesNixVersion -> SourcesNixVersion
$cpred :: SourcesNixVersion -> SourcesNixVersion
succ :: SourcesNixVersion -> SourcesNixVersion
$csucc :: SourcesNixVersion -> SourcesNixVersion
Enum, SourcesNixVersion -> SourcesNixVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcesNixVersion -> SourcesNixVersion -> Bool
$c/= :: SourcesNixVersion -> SourcesNixVersion -> Bool
== :: SourcesNixVersion -> SourcesNixVersion -> Bool
$c== :: SourcesNixVersion -> SourcesNixVersion -> Bool
Eq)

-- | A user friendly version
sourcesVersionToText :: SourcesNixVersion -> T.Text
sourcesVersionToText :: SourcesNixVersion -> Text
sourcesVersionToText = \case
  SourcesNixVersion
V1 -> Text
"1"
  SourcesNixVersion
V2 -> Text
"2"
  SourcesNixVersion
V3 -> Text
"3"
  SourcesNixVersion
V4 -> Text
"4"
  SourcesNixVersion
V5 -> Text
"5"
  SourcesNixVersion
V6 -> Text
"6"
  SourcesNixVersion
V7 -> Text
"7"
  SourcesNixVersion
V8 -> Text
"8"
  SourcesNixVersion
V9 -> Text
"9"
  SourcesNixVersion
V10 -> Text
"10"
  SourcesNixVersion
V11 -> Text
"11"
  SourcesNixVersion
V12 -> Text
"12"
  SourcesNixVersion
V13 -> Text
"13"
  SourcesNixVersion
V14 -> Text
"14"
  SourcesNixVersion
V15 -> Text
"15"
  SourcesNixVersion
V16 -> Text
"16"
  SourcesNixVersion
V17 -> Text
"17"
  SourcesNixVersion
V18 -> Text
"18"
  SourcesNixVersion
V19 -> Text
"19"
  SourcesNixVersion
V20 -> Text
"20"
  SourcesNixVersion
V21 -> Text
"21"
  SourcesNixVersion
V22 -> Text
"22"
  SourcesNixVersion
V23 -> Text
"23"
  SourcesNixVersion
V24 -> Text
"24"
  SourcesNixVersion
V25 -> Text
"25"
  SourcesNixVersion
V26 -> Text
"26"
  SourcesNixVersion
V27 -> Text
"27"
  SourcesNixVersion
V28 -> Text
"28"

latestVersionMD5 :: T.Text
latestVersionMD5 :: Text
latestVersionMD5 = SourcesNixVersion -> Text
sourcesVersionToMD5 forall a. Bounded a => a
maxBound

-- | Find a version based on the md5 of the nix/sources.nix
md5ToSourcesVersion :: T.Text -> Maybe SourcesNixVersion
md5ToSourcesVersion :: Text -> Maybe SourcesNixVersion
md5ToSourcesVersion Text
md5 =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SourcesNixVersion
snv -> SourcesNixVersion -> Text
sourcesVersionToMD5 SourcesNixVersion
snv forall a. Eq a => a -> a -> Bool
== Text
md5) [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

-- | The MD5 sum of a particular version
sourcesVersionToMD5 :: SourcesNixVersion -> T.Text
sourcesVersionToMD5 :: SourcesNixVersion -> Text
sourcesVersionToMD5 = \case
  SourcesNixVersion
V1 -> Text
"a7d3532c70fea66ffa25d6bc7ee49ad5"
  SourcesNixVersion
V2 -> Text
"24cc0719fa744420a04361e23a3598d0"
  SourcesNixVersion
V3 -> Text
"e01ed051e2c416e0fc7355fc72aeee3d"
  SourcesNixVersion
V4 -> Text
"f754fe0e661b61abdcd32cb4062f5014"
  SourcesNixVersion
V5 -> Text
"c34523590ff7dec7bf0689f145df29d1"
  SourcesNixVersion
V6 -> Text
"8143f1db1e209562faf80a998be4929a"
  SourcesNixVersion
V7 -> Text
"00a02cae76d30bbef96f001cabeed96f"
  SourcesNixVersion
V8 -> Text
"e8b860753dd7fa1fd7b805dd836eb607"
  SourcesNixVersion
V9 -> Text
"87149616c1b3b1e5aa73178f91c20b53"
  SourcesNixVersion
V10 -> Text
"d8625c0a03dd935e1c79f46407faa8d3"
  SourcesNixVersion
V11 -> Text
"8a95b7d93b16f7c7515d98f49b0ec741"
  SourcesNixVersion
V12 -> Text
"2f9629ad9a8f181ed71d2a59b454970c"
  SourcesNixVersion
V13 -> Text
"5e23c56b92eaade4e664cb16dcac1e0a"
  SourcesNixVersion
V14 -> Text
"b470e235e7bcbf106d243fea90b6cfc9"
  SourcesNixVersion
V15 -> Text
"dc11af910773ec9b4e505e0f49ebcfd2"
  SourcesNixVersion
V16 -> Text
"2d93c52cab8e960e767a79af05ca572a"
  SourcesNixVersion
V17 -> Text
"149b8907f7b08dc1c28164dfa55c7fad"
  SourcesNixVersion
V18 -> Text
"bc5e6aefcaa6f9e0b2155ca4f44e5a33"
  SourcesNixVersion
V19 -> Text
"543621698065cfc6a4a7985af76df718"
  SourcesNixVersion
V20 -> Text
"ab4263aa63ccf44b4e1510149ce14eff"
  SourcesNixVersion
V21 -> Text
"c501eee378828f7f49828a140dbdbca3"
  SourcesNixVersion
V22 -> Text
"935d1d2f0bf95fda977a6e3a7e548ed4"
  SourcesNixVersion
V23 -> Text
"4111204b613ec688e2669516dd313440"
  SourcesNixVersion
V24 -> Text
"116c2d936f1847112fef0013771dab28"
  SourcesNixVersion
V25 -> Text
"6612caee5814670e5e4d9dd1b71b5f70"
  SourcesNixVersion
V26 -> Text
"937bff93370a064c9000f13cec5867f9"
  SourcesNixVersion
V27 -> Text
"8031ba9d8fbbc7401c800d0b84278ec8"
  SourcesNixVersion
V28 -> Text
"26ed55356db7673935329210a4f8c4a5"

-- | The MD5 sum of ./nix/sources.nix
sourcesNixMD5 :: IO T.Text
sourcesNixMD5 :: IO Text
sourcesNixMD5 = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MD5Digest
MD5.md5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL8.readFile FilePath
pathNixSourcesNix

-- | @nix/sources.nix@
pathNixSourcesNix :: FilePath
pathNixSourcesNix :: FilePath
pathNixSourcesNix = FilePath
"nix" FilePath -> ShowS
</> FilePath
"sources.nix"

warnIfOutdated :: IO ()
warnIfOutdated :: IO ()
warnIfOutdated = do
  forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (FilePath -> IO ByteString
BL8.readFile FilePath
pathNixSourcesNix) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left SomeException
e ->
      forall (io :: * -> *). MonadIO io => Text -> io ()
twarn forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
T.unlines
          [ [Text] -> Text
T.unwords [Text
"Could not read", FilePath -> Text
T.pack FilePath
pathNixSourcesNix],
            [Text] -> Text
T.unwords [Text
"  ", Text
"(", forall a. Show a => a -> Text
tshow SomeException
e, Text
")"]
          ]
    Right ByteString
content -> do
      case Text -> Maybe SourcesNixVersion
md5ToSourcesVersion (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ ByteString -> MD5Digest
MD5.md5 ByteString
content) of
        -- This is a custom or newer version, we don't do anything
        Maybe SourcesNixVersion
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just SourcesNixVersion
v
          -- The file is the latest
          | SourcesNixVersion
v forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          -- The file is older than than latest
          | Bool
otherwise -> do
              forall (io :: * -> *). MonadIO io => Text -> io ()
tsay forall a b. (a -> b) -> a -> b
$
                [Text] -> Text
T.unlines
                  [ [Text] -> Text
T.unwords
                      [ T
tbold forall a b. (a -> b) -> a -> b
$ T
tblue Text
"INFO:",
                        Text
"new sources.nix available:",
                        SourcesNixVersion -> Text
sourcesVersionToText SourcesNixVersion
v,
                        Text
"->",
                        SourcesNixVersion -> Text
sourcesVersionToText forall a. Bounded a => a
maxBound
                      ],
                    Text
"  Please run 'niv init' or add the following line in the "
                      forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
pathNixSourcesNix
                      forall a. Semigroup a => a -> a -> a
<> Text
" file:",
                    Text
"  # niv: no_update"
                  ]

-- | Glue code between nix and sources.json
initNixSourcesNixContent :: B.ByteString
initNixSourcesNixContent :: ByteString
initNixSourcesNixContent = $(embedFile "nix/sources.nix")

-- | Empty JSON map
initNixSourcesJsonContent :: B.ByteString
initNixSourcesJsonContent :: ByteString
initNixSourcesJsonContent = ByteString
"{}"