{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Stack.Lock
( lockCachedWanted
, LockedLocation (..)
, Locked (..)
) where
import Data.ByteString.Builder ( byteString )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import Pantry.Internal.AesonExtended
( FromJSON (..), ToJSON, Value, WithJSONWarnings (..), (.=)
, (..:), jsonSubWarnings, jsonSubWarningsT, logJSONWarnings
, object
, withObjectWarnings
)
import Path ( parent )
import Path.Extended ( addExtension )
import Path.IO ( doesFileExist )
import Stack.Prelude
import Stack.SourceMap ( snapToDepPackage )
import Stack.Types.Config.Exception ( ConfigPrettyException (..) )
import Stack.Types.LockFileBehavior ( LockFileBehavior (..) )
import Stack.Types.Runner ( HasRunner, lockFileBehaviorL, rslInLogL )
import Stack.Types.SourceMap ( DepPackage, SMWanted )
data LockPrettyException
= WritingLockFileError (Path Abs File) Locked
deriving (Int -> LockPrettyException -> ShowS
[LockPrettyException] -> ShowS
LockPrettyException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockPrettyException] -> ShowS
$cshowList :: [LockPrettyException] -> ShowS
show :: LockPrettyException -> String
$cshow :: LockPrettyException -> String
showsPrec :: Int -> LockPrettyException -> ShowS
$cshowsPrec :: Int -> LockPrettyException -> ShowS
Show, Typeable)
instance Pretty LockPrettyException where
pretty :: LockPrettyException -> StyleDoc
pretty (WritingLockFileError Path Abs File
lockFile Locked
newLocked) =
StyleDoc
"[S-1353]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"Stack is configured to report an error on writing a lock file."
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"Stack just tried to write the following lock file content to"
, forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
lockFile forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
string String
newLocked'
where
newLocked' :: String
newLocked' = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
Yaml.encode Locked
newLocked
instance Exception LockPrettyException
data LockedLocation a b = LockedLocation
{ forall a b. LockedLocation a b -> a
llOriginal :: a
, forall a b. LockedLocation a b -> b
llCompleted :: b
}
deriving (LockedLocation a b -> LockedLocation a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
LockedLocation a b -> LockedLocation a b -> Bool
/= :: LockedLocation a b -> LockedLocation a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
LockedLocation a b -> LockedLocation a b -> Bool
== :: LockedLocation a b -> LockedLocation a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
LockedLocation a b -> LockedLocation a b -> Bool
Eq, Int -> LockedLocation a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> LockedLocation a b -> ShowS
forall a b. (Show a, Show b) => [LockedLocation a b] -> ShowS
forall a b. (Show a, Show b) => LockedLocation a b -> String
showList :: [LockedLocation a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [LockedLocation a b] -> ShowS
show :: LockedLocation a b -> String
$cshow :: forall a b. (Show a, Show b) => LockedLocation a b -> String
showsPrec :: Int -> LockedLocation a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> LockedLocation a b -> ShowS
Show)
instance (ToJSON a, ToJSON b) => ToJSON (LockedLocation a b) where
toJSON :: LockedLocation a b -> Value
toJSON LockedLocation a b
ll =
[Pair] -> Value
object [ Key
"original" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. LockedLocation a b -> a
llOriginal LockedLocation a b
ll, Key
"completed" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. LockedLocation a b -> b
llCompleted LockedLocation a b
ll ]
instance ( FromJSON (WithJSONWarnings (Unresolved a))
, FromJSON (WithJSONWarnings (Unresolved b))
) =>
FromJSON (WithJSONWarnings (Unresolved (LockedLocation a b))) where
parseJSON :: Value
-> Parser (WithJSONWarnings (Unresolved (LockedLocation a b)))
parseJSON =
forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"LockedLocation" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Unresolved a
original <- forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"original"
Unresolved b
completed <- forall a. WarningParser (WithJSONWarnings a) -> WarningParser a
jsonSubWarnings forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"completed"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> LockedLocation a b
LockedLocation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unresolved a
original forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Unresolved b
completed
newtype SingleRPLI
= SingleRPLI { SingleRPLI -> RawPackageLocationImmutable
unSingleRPLI :: RawPackageLocationImmutable}
instance FromJSON (WithJSONWarnings (Unresolved SingleRPLI)) where
parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved SingleRPLI))
parseJSON Value
v =
do
WithJSONWarnings Unresolved (NonEmpty RawPackageLocationImmutable)
unresolvedRPLIs [JSONWarning]
ws <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
let withWarnings :: a -> WithJSONWarnings a
withWarnings a
x = forall a. a -> [JSONWarning] -> WithJSONWarnings a
WithJSONWarnings a
x [JSONWarning]
ws
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a}. a -> WithJSONWarnings a
withWarnings forall a b. (a -> b) -> a -> b
$ RawPackageLocationImmutable -> SingleRPLI
SingleRPLI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unresolved (NonEmpty RawPackageLocationImmutable)
unresolvedRPLIs
data Locked = Locked
{ Locked -> [LockedLocation RawSnapshotLocation SnapshotLocation]
lckSnapshotLocations :: [LockedLocation RawSnapshotLocation SnapshotLocation]
, Locked
-> [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lckPkgImmutableLocations :: [LockedLocation RawPackageLocationImmutable PackageLocationImmutable]
}
deriving (Locked -> Locked -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Locked -> Locked -> Bool
$c/= :: Locked -> Locked -> Bool
== :: Locked -> Locked -> Bool
$c== :: Locked -> Locked -> Bool
Eq, Int -> Locked -> ShowS
[Locked] -> ShowS
Locked -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Locked] -> ShowS
$cshowList :: [Locked] -> ShowS
show :: Locked -> String
$cshow :: Locked -> String
showsPrec :: Int -> Locked -> ShowS
$cshowsPrec :: Int -> Locked -> ShowS
Show)
instance ToJSON Locked where
toJSON :: Locked -> Value
toJSON Locked {[LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
[LockedLocation RawSnapshotLocation SnapshotLocation]
lckPkgImmutableLocations :: [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lckSnapshotLocations :: [LockedLocation RawSnapshotLocation SnapshotLocation]
lckPkgImmutableLocations :: Locked
-> [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lckSnapshotLocations :: Locked -> [LockedLocation RawSnapshotLocation SnapshotLocation]
..} =
[Pair] -> Value
object
[ Key
"snapshots" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [LockedLocation RawSnapshotLocation SnapshotLocation]
lckSnapshotLocations
, Key
"packages" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lckPkgImmutableLocations
]
instance FromJSON (WithJSONWarnings (Unresolved Locked)) where
parseJSON :: Value -> Parser (WithJSONWarnings (Unresolved Locked))
parseJSON = forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"Locked" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
[Unresolved (LockedLocation RawSnapshotLocation SnapshotLocation)]
snapshots <- forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"snapshots"
[Unresolved (LockedLocation SingleRPLI PackageLocationImmutable)]
packages <- forall (t :: * -> *) a.
Traversable t =>
WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a)
jsonSubWarningsT forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"packages"
let unwrap :: LockedLocation SingleRPLI b
-> LockedLocation RawPackageLocationImmutable b
unwrap LockedLocation SingleRPLI b
ll = LockedLocation SingleRPLI b
ll { llOriginal :: RawPackageLocationImmutable
llOriginal = SingleRPLI -> RawPackageLocationImmutable
unSingleRPLI (forall a b. LockedLocation a b -> a
llOriginal LockedLocation SingleRPLI b
ll) }
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [LockedLocation RawSnapshotLocation SnapshotLocation]
-> [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
-> Locked
Locked forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Unresolved (LockedLocation RawSnapshotLocation SnapshotLocation)]
snapshots forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (a -> b) -> [a] -> [b]
map forall {b}.
LockedLocation SingleRPLI b
-> LockedLocation RawPackageLocationImmutable b
unwrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Unresolved (LockedLocation SingleRPLI PackageLocationImmutable)]
packages)
loadYamlThrow ::
HasLogFunc env
=> (Value -> Yaml.Parser (WithJSONWarnings a))
-> Path Abs File
-> RIO env a
loadYamlThrow :: forall env a.
HasLogFunc env =>
(Value -> Parser (WithJSONWarnings a))
-> Path Abs File -> RIO env a
loadYamlThrow Value -> Parser (WithJSONWarnings a)
parser Path Abs File
path = do
Either ParseException Value
eVal <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither (forall b t. Path b t -> String
toFilePath Path Abs File
path)
case Either ParseException Value
eVal of
Left ParseException
parseException -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$
Path Abs File -> ParseException -> ConfigPrettyException
ParseConfigFileException Path Abs File
path ParseException
parseException
Right Value
val -> case forall a b. (a -> Parser b) -> a -> Either String b
Yaml.parseEither Value -> Parser (WithJSONWarnings a)
parser Value
val of
Left String
err -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ParseException
Yaml.AesonException String
err
Right (WithJSONWarnings a
res [JSONWarning]
warnings) -> do
forall env (m :: * -> *).
(MonadReader env m, HasLogFunc env, HasCallStack, MonadIO m) =>
String -> [JSONWarning] -> m ()
logJSONWarnings (forall b t. Path b t -> String
toFilePath Path Abs File
path) [JSONWarning]
warnings
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
lockCachedWanted ::
(HasPantryConfig env, HasRunner env)
=> Path Abs File
-> RawSnapshotLocation
-> ( Map RawPackageLocationImmutable PackageLocationImmutable
-> WantedCompiler
-> Map PackageName (Bool -> RIO env DepPackage)
-> RIO env ( SMWanted, [CompletedPLI])
)
-> RIO env SMWanted
lockCachedWanted :: forall env.
(HasPantryConfig env, HasRunner env) =>
Path Abs File
-> RawSnapshotLocation
-> (Map RawPackageLocationImmutable PackageLocationImmutable
-> WantedCompiler
-> Map PackageName (Bool -> RIO env DepPackage)
-> RIO env (SMWanted, [CompletedPLI]))
-> RIO env SMWanted
lockCachedWanted Path Abs File
stackFile RawSnapshotLocation
resolver Map RawPackageLocationImmutable PackageLocationImmutable
-> WantedCompiler
-> Map PackageName (Bool -> RIO env DepPackage)
-> RIO env (SMWanted, [CompletedPLI])
fillWanted = do
Path Abs File
lockFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadThrow m =>
String -> Path b File -> m (Path b File)
addExtension String
".lock" Path Abs File
stackFile
let getLockExists :: RIO env Bool
getLockExists = forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
lockFile
LockFileBehavior
lfb <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasRunner env => SimpleGetter env LockFileBehavior
lockFileBehaviorL
Bool
readLockFile <-
case LockFileBehavior
lfb of
LockFileBehavior
LFBIgnore -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
LockFileBehavior
LFBReadWrite -> RIO env Bool
getLockExists
LockFileBehavior
LFBReadOnly -> RIO env Bool
getLockExists
LockFileBehavior
LFBErrorOnWrite -> RIO env Bool
getLockExists
Locked
locked <-
if Bool
readLockFile
then do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Using package location completions from a lock file"
Unresolved Locked
unresolvedLocked <- forall env a.
HasLogFunc env =>
(Value -> Parser (WithJSONWarnings a))
-> Path Abs File -> RIO env a
loadYamlThrow forall a. FromJSON a => Value -> Parser a
parseJSON Path Abs File
lockFile
forall (m :: * -> *) a.
MonadIO m =>
Maybe (Path Abs Dir) -> Unresolved a -> m a
resolvePaths (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> Path b Dir
parent Path Abs File
stackFile) Unresolved Locked
unresolvedLocked
else do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Not reading lock file"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [LockedLocation RawSnapshotLocation SnapshotLocation]
-> [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
-> Locked
Locked [] []
let toMap :: Ord a => [LockedLocation a b] -> Map a b
toMap :: forall a b. Ord a => [LockedLocation a b] -> Map a b
toMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. LockedLocation a b -> a
llOriginal forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a b. LockedLocation a b -> b
llCompleted)
slocCache :: Map RawSnapshotLocation SnapshotLocation
slocCache = forall a b. Ord a => [LockedLocation a b] -> Map a b
toMap forall a b. (a -> b) -> a -> b
$ Locked -> [LockedLocation RawSnapshotLocation SnapshotLocation]
lckSnapshotLocations Locked
locked
pkgLocCache :: Map RawPackageLocationImmutable PackageLocationImmutable
pkgLocCache = forall a b. Ord a => [LockedLocation a b] -> Map a b
toMap forall a b. (a -> b) -> a -> b
$ Locked
-> [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lckPkgImmutableLocations Locked
locked
Bool
debugRSL <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasRunner env => SimpleGetter env Bool
rslInLogL
(Snapshot
snap, [CompletedSL]
slocCompleted, [CompletedPLI]
pliCompleted) <-
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Bool
-> RawSnapshotLocation
-> Map RawSnapshotLocation SnapshotLocation
-> Map RawPackageLocationImmutable PackageLocationImmutable
-> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
loadAndCompleteSnapshotRaw' Bool
debugRSL RawSnapshotLocation
resolver Map RawSnapshotLocation SnapshotLocation
slocCache Map RawPackageLocationImmutable PackageLocationImmutable
pkgLocCache
let compiler :: WantedCompiler
compiler = Snapshot -> WantedCompiler
snapshotCompiler Snapshot
snap
snPkgs :: Map PackageName (Bool -> RIO env DepPackage)
snPkgs = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
(\PackageName
n SnapshotPackage
p Bool
h -> forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Bool -> PackageName -> SnapshotPackage -> RIO env DepPackage
snapToDepPackage Bool
h PackageName
n SnapshotPackage
p)
(Snapshot -> Map PackageName SnapshotPackage
snapshotPackages Snapshot
snap)
(SMWanted
wanted, [CompletedPLI]
prjCompleted) <- Map RawPackageLocationImmutable PackageLocationImmutable
-> WantedCompiler
-> Map PackageName (Bool -> RIO env DepPackage)
-> RIO env (SMWanted, [CompletedPLI])
fillWanted Map RawPackageLocationImmutable PackageLocationImmutable
pkgLocCache WantedCompiler
compiler Map PackageName (Bool -> RIO env DepPackage)
snPkgs
let lockLocations :: [CompletedPLI]
-> [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lockLocations = forall a b. (a -> b) -> [a] -> [b]
map (\(CompletedPLI RawPackageLocationImmutable
r PackageLocationImmutable
c) -> forall a b. a -> b -> LockedLocation a b
LockedLocation RawPackageLocationImmutable
r PackageLocationImmutable
c)
differentSnapLocs :: CompletedSL
-> Maybe (LockedLocation RawSnapshotLocation SnapshotLocation)
differentSnapLocs (CompletedSL RawSnapshotLocation
raw SnapshotLocation
complete)
| RawSnapshotLocation
raw forall a. Eq a => a -> a -> Bool
== SnapshotLocation -> RawSnapshotLocation
toRawSL SnapshotLocation
complete = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> LockedLocation a b
LockedLocation RawSnapshotLocation
raw SnapshotLocation
complete
newLocked :: Locked
newLocked = Locked
{ lckSnapshotLocations :: [LockedLocation RawSnapshotLocation SnapshotLocation]
lckSnapshotLocations = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CompletedSL
-> Maybe (LockedLocation RawSnapshotLocation SnapshotLocation)
differentSnapLocs [CompletedSL]
slocCompleted
, lckPkgImmutableLocations :: [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lckPkgImmutableLocations =
[CompletedPLI]
-> [LockedLocation
RawPackageLocationImmutable PackageLocationImmutable]
lockLocations forall a b. (a -> b) -> a -> b
$ [CompletedPLI]
pliCompleted forall a. Semigroup a => a -> a -> a
<> [CompletedPLI]
prjCompleted
}
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Locked
newLocked forall a. Eq a => a -> a -> Bool
/= Locked
locked) forall a b. (a -> b) -> a -> b
$
case LockFileBehavior
lfb of
LockFileBehavior
LFBReadWrite ->
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
lockFile forall a b. (a -> b) -> a -> b
$
Builder
header forall a. Semigroup a => a -> a -> a
<>
ByteString -> Builder
byteString (forall a. ToJSON a => a -> ByteString
Yaml.encode Locked
newLocked)
LockFileBehavior
LFBErrorOnWrite ->
forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO forall a b. (a -> b) -> a -> b
$ Path Abs File -> Locked -> LockPrettyException
WritingLockFileError Path Abs File
lockFile Locked
newLocked
LockFileBehavior
LFBIgnore -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
LockFileBehavior
LFBReadOnly -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure SMWanted
wanted
where
header :: Builder
header =
Builder
"# This file was autogenerated by Stack.\n\
\# You should not edit this file by hand.\n\
\# For more information, please see the documentation at:\n\
\# https://docs.haskellstack.org/en/stable/lock_files\n\n"