-- | A crude implementation of the Nix store concept.
--
-- For anything fancier than this, it would be best to use FFI bindings instead,
-- such as hercules-ci-cnix-store.
module Nix.Diff.Store
  ( StorePath (..),
    toPhysicalPath,
    toText,
    doesFileExist,
    readFileUtf8Lenient,
  )
where

import Control.Monad ((<=<))
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import qualified Data.ByteString
import Data.Data (Data)
import Data.Functor ((<&>))
import qualified Data.List as L
import Data.Text (Text)
import qualified Data.Text.Encoding
import qualified Data.Text.Encoding.Error
import qualified System.Directory as Directory
import System.Environment (lookupEnv)
import Test.QuickCheck (Arbitrary)
import qualified Data.Text as T

-- | A file path that may not exist on the true file system;
-- needs to be looked up in a store, which may be relocated.
--
-- Unlike the (C++) Nix StorePath type, subpaths are allowed.
newtype StorePath = StorePath
  { -- | If the store is relocated, its physical location is elsewhere, and this 'FilePath' won't resolve.
    -- Use 'toPhysicalPath'.
    StorePath -> [Char]
unsafeStorePathFile :: FilePath
  }
  deriving (Typeable StorePath
Typeable StorePath =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> StorePath -> c StorePath)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StorePath)
-> (StorePath -> Constr)
-> (StorePath -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StorePath))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StorePath))
-> ((forall b. Data b => b -> b) -> StorePath -> StorePath)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StorePath -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StorePath -> r)
-> (forall u. (forall d. Data d => d -> u) -> StorePath -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StorePath -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> StorePath -> m StorePath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StorePath -> m StorePath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StorePath -> m StorePath)
-> Data StorePath
StorePath -> Constr
StorePath -> DataType
(forall b. Data b => b -> b) -> StorePath -> StorePath
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StorePath -> u
forall u. (forall d. Data d => d -> u) -> StorePath -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StorePath -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StorePath -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StorePath
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StorePath -> c StorePath
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StorePath)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StorePath)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StorePath -> c StorePath
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StorePath -> c StorePath
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StorePath
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StorePath
$ctoConstr :: StorePath -> Constr
toConstr :: StorePath -> Constr
$cdataTypeOf :: StorePath -> DataType
dataTypeOf :: StorePath -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StorePath)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StorePath)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StorePath)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StorePath)
$cgmapT :: (forall b. Data b => b -> b) -> StorePath -> StorePath
gmapT :: (forall b. Data b => b -> b) -> StorePath -> StorePath
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StorePath -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StorePath -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StorePath -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StorePath -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StorePath -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> StorePath -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StorePath -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StorePath -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StorePath -> m StorePath
Data)
  deriving newtype (Int -> StorePath -> ShowS
[StorePath] -> ShowS
StorePath -> [Char]
(Int -> StorePath -> ShowS)
-> (StorePath -> [Char])
-> ([StorePath] -> ShowS)
-> Show StorePath
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorePath -> ShowS
showsPrec :: Int -> StorePath -> ShowS
$cshow :: StorePath -> [Char]
show :: StorePath -> [Char]
$cshowList :: [StorePath] -> ShowS
showList :: [StorePath] -> ShowS
Show, StorePath -> StorePath -> Bool
(StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool) -> Eq StorePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorePath -> StorePath -> Bool
== :: StorePath -> StorePath -> Bool
$c/= :: StorePath -> StorePath -> Bool
/= :: StorePath -> StorePath -> Bool
Eq, Eq StorePath
Eq StorePath =>
(StorePath -> StorePath -> Ordering)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> Bool)
-> (StorePath -> StorePath -> StorePath)
-> (StorePath -> StorePath -> StorePath)
-> Ord StorePath
StorePath -> StorePath -> Bool
StorePath -> StorePath -> Ordering
StorePath -> StorePath -> StorePath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StorePath -> StorePath -> Ordering
compare :: StorePath -> StorePath -> Ordering
$c< :: StorePath -> StorePath -> Bool
< :: StorePath -> StorePath -> Bool
$c<= :: StorePath -> StorePath -> Bool
<= :: StorePath -> StorePath -> Bool
$c> :: StorePath -> StorePath -> Bool
> :: StorePath -> StorePath -> Bool
$c>= :: StorePath -> StorePath -> Bool
>= :: StorePath -> StorePath -> Bool
$cmax :: StorePath -> StorePath -> StorePath
max :: StorePath -> StorePath -> StorePath
$cmin :: StorePath -> StorePath -> StorePath
min :: StorePath -> StorePath -> StorePath
Ord, [StorePath] -> Value
[StorePath] -> Encoding
StorePath -> Bool
StorePath -> Value
StorePath -> Encoding
(StorePath -> Value)
-> (StorePath -> Encoding)
-> ([StorePath] -> Value)
-> ([StorePath] -> Encoding)
-> (StorePath -> Bool)
-> ToJSON StorePath
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StorePath -> Value
toJSON :: StorePath -> Value
$ctoEncoding :: StorePath -> Encoding
toEncoding :: StorePath -> Encoding
$ctoJSONList :: [StorePath] -> Value
toJSONList :: [StorePath] -> Value
$ctoEncodingList :: [StorePath] -> Encoding
toEncodingList :: [StorePath] -> Encoding
$comitField :: StorePath -> Bool
omitField :: StorePath -> Bool
ToJSON, Maybe StorePath
Value -> Parser [StorePath]
Value -> Parser StorePath
(Value -> Parser StorePath)
-> (Value -> Parser [StorePath])
-> Maybe StorePath
-> FromJSON StorePath
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StorePath
parseJSON :: Value -> Parser StorePath
$cparseJSONList :: Value -> Parser [StorePath]
parseJSONList :: Value -> Parser [StorePath]
$comittedField :: Maybe StorePath
omittedField :: Maybe StorePath
FromJSON, ToJSONKeyFunction [StorePath]
ToJSONKeyFunction StorePath
ToJSONKeyFunction StorePath
-> ToJSONKeyFunction [StorePath] -> ToJSONKey StorePath
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction StorePath
toJSONKey :: ToJSONKeyFunction StorePath
$ctoJSONKeyList :: ToJSONKeyFunction [StorePath]
toJSONKeyList :: ToJSONKeyFunction [StorePath]
ToJSONKey, FromJSONKeyFunction [StorePath]
FromJSONKeyFunction StorePath
FromJSONKeyFunction StorePath
-> FromJSONKeyFunction [StorePath] -> FromJSONKey StorePath
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction StorePath
fromJSONKey :: FromJSONKeyFunction StorePath
$cfromJSONKeyList :: FromJSONKeyFunction [StorePath]
fromJSONKeyList :: FromJSONKeyFunction [StorePath]
FromJSONKey, Gen StorePath
Gen StorePath -> (StorePath -> [StorePath]) -> Arbitrary StorePath
StorePath -> [StorePath]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen StorePath
arbitrary :: Gen StorePath
$cshrink :: StorePath -> [StorePath]
shrink :: StorePath -> [StorePath]
Arbitrary)

doesFileExist :: StorePath -> IO Bool
doesFileExist :: StorePath -> IO Bool
doesFileExist =
  [Char] -> IO Bool
Directory.doesFileExist ([Char] -> IO Bool)
-> (StorePath -> IO [Char]) -> StorePath -> IO Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< StorePath -> IO [Char]
toPhysicalPath

readFileUtf8Lenient :: StorePath -> IO Text
readFileUtf8Lenient :: StorePath -> IO Text
readFileUtf8Lenient StorePath
sp = do
  [Char]
file <- StorePath -> IO [Char]
toPhysicalPath StorePath
sp
  OnDecodeError -> ByteString -> Text
Data.Text.Encoding.decodeUtf8With OnDecodeError
Data.Text.Encoding.Error.lenientDecode
    (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
Data.ByteString.readFile [Char]
file

toPhysicalPath :: StorePath -> IO FilePath
toPhysicalPath :: StorePath -> IO [Char]
toPhysicalPath (StorePath [Char]
p) = do
  [Char]
nixStoreDir <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"NIX_STORE_DIR" IO (Maybe [Char]) -> (Maybe [Char] -> [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Char] -> ShowS -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"/nix/store" ShowS
stripSlash
  Maybe [Char]
nixRemoteMaybe <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"NIX_REMOTE" IO (Maybe [Char])
-> (Maybe [Char] -> Maybe [Char]) -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ShowS -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
stripSlash
  case Maybe [Char]
nixRemoteMaybe of
    Just [Char]
nixRemote | [Char]
nixStoreDir [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
p -> do
      [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
nixRemote [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"/" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') [Char]
p
    Maybe [Char]
_ -> [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
p

-- | Convert a 'StorePath' to a 'Text' for display purposes. The path may not exist at this physical location.
toText :: StorePath -> Text
toText :: StorePath -> Text
toText (StorePath [Char]
p) = [Char] -> Text
T.pack [Char]
p

stripSlash :: FilePath -> FilePath
stripSlash :: ShowS
stripSlash [Char]
s | Bool -> Bool
not ([Char]
"/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` [Char]
s) = [Char]
s
stripSlash [Char]
s = ShowS
doIt [Char]
s
  where doIt :: ShowS
doIt = Text -> [Char]
T.unpack (Text -> [Char]) -> ([Char] -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack