{-# OPTIONS_GHC -fno-warn-missing-methods -fno-warn-orphans #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances, UndecidableSuperClasses #-}
-- Copyright (C) 2010, 2011 Petr Rockai
--
-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use, copy,
-- modify, merge, publish, distribute, sublicense, and/or sell copies
-- of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.
module Darcs.Patch.ApplyMonad
  ( ApplyMonad(..), ApplyMonadTrans(..), ApplyMonadState(..)
  , withFileNames, withFiles, ToTree(..)
  , ApplyMonadTree(..)
  ) where

import Darcs.Prelude

import qualified Data.ByteString      as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map             as M
import qualified Darcs.Util.Tree.Monad as TM
import Darcs.Util.Tree ( Tree )
import Data.Maybe ( fromMaybe )
import Darcs.Util.Path ( AnchoredPath, movedirfilename, isPrefix )
import Control.Monad.State.Strict
import Control.Monad.Identity( Identity )
import Darcs.Patch.MonadProgress

import GHC.Exts ( Constraint )

class ToTree s where
  toTree :: s m -> Tree m

instance ToTree Tree where
  toTree :: Tree m -> Tree m
toTree = Tree m -> Tree m
forall a. a -> a
id

class (Monad m, ApplyMonad state (ApplyMonadOver state m))
      => ApplyMonadTrans (state :: (* -> *) -> *) m where
  type ApplyMonadOver state m :: * -> *
  runApplyMonad :: (ApplyMonadOver state m) x -> state m -> m (x, state m)

instance Monad m => ApplyMonadTrans Tree m where
  type ApplyMonadOver Tree m = TM.TreeMonad m
  runApplyMonad :: ApplyMonadOver Tree m x -> Tree m -> m (x, Tree m)
runApplyMonad = ApplyMonadOver Tree m x -> Tree m -> m (x, Tree m)
forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
TM.virtualTreeMonad

class ApplyMonadState (state :: (* -> *) -> *) where
  type ApplyMonadStateOperations state :: (* -> *) -> Constraint

class Monad m => ApplyMonadTree m where
    -- a semantic, Tree-based interface for patch application
    mDoesDirectoryExist ::  AnchoredPath -> m Bool
    mDoesFileExist ::  AnchoredPath -> m Bool
    mReadFilePS ::  AnchoredPath -> m B.ByteString
    mCreateDirectory ::  AnchoredPath -> m ()
    mRemoveDirectory ::  AnchoredPath -> m ()
    mCreateFile ::  AnchoredPath -> m ()
    mCreateFile AnchoredPath
f = AnchoredPath -> (ByteString -> m ByteString) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> (ByteString -> m ByteString) -> m ()
mModifyFilePS AnchoredPath
f ((ByteString -> m ByteString) -> m ())
-> (ByteString -> m ByteString) -> m ()
forall a b. (a -> b) -> a -> b
$ \ByteString
_ -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
    mRemoveFile ::  AnchoredPath -> m ()
    mRename ::  AnchoredPath -> AnchoredPath -> m ()
    mModifyFilePS ::  AnchoredPath -> (B.ByteString -> m B.ByteString) -> m ()
    mChangePref ::  String -> String -> String -> m ()
    mChangePref String
_ String
_ String
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance ApplyMonadState Tree where
    type ApplyMonadStateOperations Tree = ApplyMonadTree

class ( Monad m, Monad (ApplyMonadBase m)
      , ApplyMonadStateOperations state m, ToTree state
      )
       -- ApplyMonadOver (ApplyMonadBase m) ~ m is *not* required in general,
       -- since ApplyMonadBase is not injective
       => ApplyMonad (state :: (* -> *) -> *) m where
    type ApplyMonadBase m :: * -> *

    nestedApply :: m x -> state (ApplyMonadBase m) -> m (x, state (ApplyMonadBase m))
    liftApply :: (state (ApplyMonadBase m) -> (ApplyMonadBase m) x) -> state (ApplyMonadBase m)
                 -> m (x, state (ApplyMonadBase m))

    getApplyState :: m (state (ApplyMonadBase m))

instance Monad m => ApplyMonad Tree (TM.TreeMonad m) where
    type ApplyMonadBase (TM.TreeMonad m) = m
    getApplyState :: TreeMonad m (Tree (ApplyMonadBase (TreeMonad m)))
getApplyState = (TreeState m -> Tree m)
-> RWST (TreeEnv m) () (TreeState m) m (Tree m)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TreeState m -> Tree m
forall (m :: * -> *). TreeState m -> Tree m
TM.tree
    nestedApply :: TreeMonad m x
-> Tree (ApplyMonadBase (TreeMonad m))
-> TreeMonad m (x, Tree (ApplyMonadBase (TreeMonad m)))
nestedApply TreeMonad m x
a Tree (ApplyMonadBase (TreeMonad m))
start = m (x, Tree m) -> RWST (TreeEnv m) () (TreeState m) m (x, Tree m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (x, Tree m) -> RWST (TreeEnv m) () (TreeState m) m (x, Tree m))
-> m (x, Tree m) -> RWST (TreeEnv m) () (TreeState m) m (x, Tree m)
forall a b. (a -> b) -> a -> b
$ ApplyMonadOver Tree m x -> Tree m -> m (x, Tree m)
forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonadTrans state m =>
ApplyMonadOver state m x -> state m -> m (x, state m)
runApplyMonad TreeMonad m x
ApplyMonadOver Tree m x
a Tree m
Tree (ApplyMonadBase (TreeMonad m))
start
    liftApply :: (Tree (ApplyMonadBase (TreeMonad m))
 -> ApplyMonadBase (TreeMonad m) x)
-> Tree (ApplyMonadBase (TreeMonad m))
-> TreeMonad m (x, Tree (ApplyMonadBase (TreeMonad m)))
liftApply Tree (ApplyMonadBase (TreeMonad m))
-> ApplyMonadBase (TreeMonad m) x
a Tree (ApplyMonadBase (TreeMonad m))
start = do Tree m
x <- (TreeState m -> Tree m)
-> RWST (TreeEnv m) () (TreeState m) m (Tree m)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TreeState m -> Tree m
forall (m :: * -> *). TreeState m -> Tree m
TM.tree
                           m (x, Tree m) -> RWST (TreeEnv m) () (TreeState m) m (x, Tree m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (x, Tree m) -> RWST (TreeEnv m) () (TreeState m) m (x, Tree m))
-> m (x, Tree m) -> RWST (TreeEnv m) () (TreeState m) m (x, Tree m)
forall a b. (a -> b) -> a -> b
$ ApplyMonadOver Tree m x -> Tree m -> m (x, Tree m)
forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonadTrans state m =>
ApplyMonadOver state m x -> state m -> m (x, state m)
runApplyMonad (m x -> RWST (TreeEnv m) () (TreeState m) m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m x -> RWST (TreeEnv m) () (TreeState m) m x)
-> m x -> RWST (TreeEnv m) () (TreeState m) m x
forall a b. (a -> b) -> a -> b
$ Tree (ApplyMonadBase (TreeMonad m))
-> ApplyMonadBase (TreeMonad m) x
a Tree m
Tree (ApplyMonadBase (TreeMonad m))
x) Tree m
Tree (ApplyMonadBase (TreeMonad m))
start

instance Monad m => ApplyMonadTree (TM.TreeMonad m) where

    mDoesDirectoryExist :: AnchoredPath -> TreeMonad m Bool
mDoesDirectoryExist AnchoredPath
p = AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
TM.directoryExists AnchoredPath
p
    mDoesFileExist :: AnchoredPath -> TreeMonad m Bool
mDoesFileExist AnchoredPath
p = AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
TM.fileExists AnchoredPath
p
    mReadFilePS :: AnchoredPath -> TreeMonad m ByteString
mReadFilePS AnchoredPath
p = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ByteString -> [ByteString]
BL.toChunks (ByteString -> ByteString)
-> RWST (TreeEnv m) () (TreeState m) m ByteString
-> TreeMonad m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AnchoredPath -> RWST (TreeEnv m) () (TreeState m) m ByteString
forall (m :: * -> *).
Monad m =>
AnchoredPath -> TreeMonad m ByteString
TM.readFile AnchoredPath
p
    mModifyFilePS :: AnchoredPath
-> (ByteString -> TreeMonad m ByteString) -> TreeMonad m ()
mModifyFilePS AnchoredPath
p ByteString -> TreeMonad m ByteString
j = do Bool
have <- AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
TM.fileExists AnchoredPath
p
                           ByteString
x <- if Bool
have then [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ByteString -> [ByteString]
BL.toChunks (ByteString -> ByteString)
-> RWST (TreeEnv m) () (TreeState m) m ByteString
-> TreeMonad m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AnchoredPath -> RWST (TreeEnv m) () (TreeState m) m ByteString
forall (m :: * -> *).
Monad m =>
AnchoredPath -> TreeMonad m ByteString
TM.readFile AnchoredPath
p
                                        else ByteString -> TreeMonad m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
                           AnchoredPath -> ByteString -> TreeMonad m ()
forall (m :: * -> *).
Monad m =>
AnchoredPath -> ByteString -> TreeMonad m ()
TM.writeFile AnchoredPath
p (ByteString -> TreeMonad m ())
-> (ByteString -> ByteString) -> ByteString -> TreeMonad m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> TreeMonad m ())
-> TreeMonad m ByteString -> TreeMonad m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> TreeMonad m ByteString
j ByteString
x
    mCreateDirectory :: AnchoredPath -> TreeMonad m ()
mCreateDirectory AnchoredPath
p = AnchoredPath -> TreeMonad m ()
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
TM.createDirectory AnchoredPath
p
    mRename :: AnchoredPath -> AnchoredPath -> TreeMonad m ()
mRename AnchoredPath
from AnchoredPath
to = AnchoredPath -> AnchoredPath -> TreeMonad m ()
forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
TM.rename AnchoredPath
from AnchoredPath
to
    mRemoveDirectory :: AnchoredPath -> TreeMonad m ()
mRemoveDirectory = AnchoredPath -> TreeMonad m ()
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
TM.unlink
    mRemoveFile :: AnchoredPath -> TreeMonad m ()
mRemoveFile = AnchoredPath -> TreeMonad m ()
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
TM.unlink

-- Latest name, current original name.
type OrigFileNameOf = (AnchoredPath, AnchoredPath)
-- Touched files, new file list (after removes etc.) and rename details
type FilePathMonadState = ([AnchoredPath], [AnchoredPath], [OrigFileNameOf])
type FilePathMonad = State FilePathMonadState

-- |trackOrigRename takes an old and new name and attempts to apply the mapping
-- to the OrigFileNameOf pair. If the old name is the most up-to-date name of
-- the file in question, the first element of the OFNO will match, otherwise if
-- the up-to-date name was originally old, the second element will match.
trackOrigRename :: AnchoredPath -> AnchoredPath -> OrigFileNameOf -> OrigFileNameOf
trackOrigRename :: AnchoredPath -> AnchoredPath -> OrigFileNameOf -> OrigFileNameOf
trackOrigRename AnchoredPath
old AnchoredPath
new pair :: OrigFileNameOf
pair@(AnchoredPath
latest, AnchoredPath
from)
    | AnchoredPath
old AnchoredPath -> AnchoredPath -> Bool
`isPrefix` AnchoredPath
latest = (AnchoredPath
latest, AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
old AnchoredPath
new AnchoredPath
latest)
    | AnchoredPath
old AnchoredPath -> AnchoredPath -> Bool
`isPrefix` AnchoredPath
from = (AnchoredPath
latest, AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
old AnchoredPath
new AnchoredPath
from)
    | Bool
otherwise = OrigFileNameOf
pair

-- |withFileNames takes a maybe list of existing rename-pairs, a list of
-- filenames and an action, and returns the resulting triple of affected files,
-- updated filename list and new rename details. If the rename-pairs are not
-- present, a new list is generated from the filesnames.
withFileNames :: Maybe [OrigFileNameOf] -> [AnchoredPath] -> FilePathMonad a
    -> FilePathMonadState
withFileNames :: Maybe [OrigFileNameOf]
-> [AnchoredPath] -> FilePathMonad a -> FilePathMonadState
withFileNames Maybe [OrigFileNameOf]
mbofnos [AnchoredPath]
fps FilePathMonad a
x = FilePathMonad a -> FilePathMonadState -> FilePathMonadState
forall s a. State s a -> s -> s
execState FilePathMonad a
x ([], [AnchoredPath]
fps, [OrigFileNameOf]
ofnos) where
    ofnos :: [OrigFileNameOf]
ofnos = [OrigFileNameOf] -> Maybe [OrigFileNameOf] -> [OrigFileNameOf]
forall a. a -> Maybe a -> a
fromMaybe ((AnchoredPath -> OrigFileNameOf)
-> [AnchoredPath] -> [OrigFileNameOf]
forall a b. (a -> b) -> [a] -> [b]
map (\AnchoredPath
y -> (AnchoredPath
y, AnchoredPath
y)) [AnchoredPath]
fps) Maybe [OrigFileNameOf]
mbofnos

instance ApplyMonad Tree FilePathMonad where
    type ApplyMonadBase FilePathMonad = Identity


instance ApplyMonadTree FilePathMonad where
    -- We can't check it actually is a directory here
    mDoesDirectoryExist :: AnchoredPath -> FilePathMonad Bool
mDoesDirectoryExist AnchoredPath
p = (FilePathMonadState -> Bool) -> FilePathMonad Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((FilePathMonadState -> Bool) -> FilePathMonad Bool)
-> (FilePathMonadState -> Bool) -> FilePathMonad Bool
forall a b. (a -> b) -> a -> b
$ \([AnchoredPath]
_, [AnchoredPath]
fs, [OrigFileNameOf]
_) -> AnchoredPath
p AnchoredPath -> [AnchoredPath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AnchoredPath]
fs

    mCreateDirectory :: AnchoredPath -> FilePathMonad ()
mCreateDirectory = AnchoredPath -> FilePathMonad ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mCreateFile
    mCreateFile :: AnchoredPath -> FilePathMonad ()
mCreateFile AnchoredPath
f = (FilePathMonadState -> FilePathMonadState) -> FilePathMonad ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FilePathMonadState -> FilePathMonadState) -> FilePathMonad ())
-> (FilePathMonadState -> FilePathMonadState) -> FilePathMonad ()
forall a b. (a -> b) -> a -> b
$ \([AnchoredPath]
ms, [AnchoredPath]
fs, [OrigFileNameOf]
rns) -> (AnchoredPath
f AnchoredPath -> [AnchoredPath] -> [AnchoredPath]
forall a. a -> [a] -> [a]
: [AnchoredPath]
ms, [AnchoredPath]
fs, [OrigFileNameOf]
rns)
    mRemoveFile :: AnchoredPath -> FilePathMonad ()
mRemoveFile AnchoredPath
f = (FilePathMonadState -> FilePathMonadState) -> FilePathMonad ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FilePathMonadState -> FilePathMonadState) -> FilePathMonad ())
-> (FilePathMonadState -> FilePathMonadState) -> FilePathMonad ()
forall a b. (a -> b) -> a -> b
$ \([AnchoredPath]
ms, [AnchoredPath]
fs, [OrigFileNameOf]
rns) -> (AnchoredPath
f AnchoredPath -> [AnchoredPath] -> [AnchoredPath]
forall a. a -> [a] -> [a]
: [AnchoredPath]
ms, (AnchoredPath -> Bool) -> [AnchoredPath] -> [AnchoredPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
f) [AnchoredPath]
fs, [OrigFileNameOf]
rns)
    mRemoveDirectory :: AnchoredPath -> FilePathMonad ()
mRemoveDirectory = AnchoredPath -> FilePathMonad ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mRemoveFile
    mRename :: AnchoredPath -> AnchoredPath -> FilePathMonad ()
mRename AnchoredPath
a AnchoredPath
b =
        (FilePathMonadState -> FilePathMonadState) -> FilePathMonad ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FilePathMonadState -> FilePathMonadState) -> FilePathMonad ())
-> (FilePathMonadState -> FilePathMonadState) -> FilePathMonad ()
forall a b. (a -> b) -> a -> b
$ \([AnchoredPath]
ms, [AnchoredPath]
fs, [OrigFileNameOf]
rns) -> ( AnchoredPath
a AnchoredPath -> [AnchoredPath] -> [AnchoredPath]
forall a. a -> [a] -> [a]
: AnchoredPath
b AnchoredPath -> [AnchoredPath] -> [AnchoredPath]
forall a. a -> [a] -> [a]
: [AnchoredPath]
ms
                                   , (AnchoredPath -> AnchoredPath) -> [AnchoredPath] -> [AnchoredPath]
forall a b. (a -> b) -> [a] -> [b]
map (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
a AnchoredPath
b) [AnchoredPath]
fs
                                   , (OrigFileNameOf -> OrigFileNameOf)
-> [OrigFileNameOf] -> [OrigFileNameOf]
forall a b. (a -> b) -> [a] -> [b]
map (AnchoredPath -> AnchoredPath -> OrigFileNameOf -> OrigFileNameOf
trackOrigRename AnchoredPath
a AnchoredPath
b) [OrigFileNameOf]
rns)
    mModifyFilePS :: AnchoredPath
-> (ByteString -> FilePathMonad ByteString) -> FilePathMonad ()
mModifyFilePS AnchoredPath
f ByteString -> FilePathMonad ByteString
_ = AnchoredPath -> FilePathMonad ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mCreateFile AnchoredPath
f

instance MonadProgress FilePathMonad where
  runProgressActions :: String -> [ProgressAction FilePathMonad ()] -> FilePathMonad ()
runProgressActions = String -> [ProgressAction FilePathMonad ()] -> FilePathMonad ()
forall (m :: * -> *).
Monad m =>
String -> [ProgressAction m ()] -> m ()
silentlyRunProgressActions

type RestrictedApply = State (M.Map AnchoredPath B.ByteString)

instance ApplyMonad Tree RestrictedApply where
  type ApplyMonadBase RestrictedApply = Identity

instance ApplyMonadTree RestrictedApply where
  mDoesDirectoryExist :: AnchoredPath -> RestrictedApply Bool
mDoesDirectoryExist AnchoredPath
_ = Bool -> RestrictedApply Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  mCreateDirectory :: AnchoredPath -> RestrictedApply ()
mCreateDirectory AnchoredPath
_ = () -> RestrictedApply ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  mRemoveFile :: AnchoredPath -> RestrictedApply ()
mRemoveFile AnchoredPath
f = (Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
-> RestrictedApply ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
 -> RestrictedApply ())
-> (Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
-> RestrictedApply ()
forall a b. (a -> b) -> a -> b
$ AnchoredPath
-> Map AnchoredPath ByteString -> Map AnchoredPath ByteString
forall k a. Ord k => k -> Map k a -> Map k a
M.delete AnchoredPath
f
  mRemoveDirectory :: AnchoredPath -> RestrictedApply ()
mRemoveDirectory AnchoredPath
_ = () -> RestrictedApply ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  mRename :: AnchoredPath -> AnchoredPath -> RestrictedApply ()
mRename AnchoredPath
a AnchoredPath
b = (Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
-> RestrictedApply ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
 -> RestrictedApply ())
-> (Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
-> RestrictedApply ()
forall a b. (a -> b) -> a -> b
$ (AnchoredPath -> AnchoredPath)
-> Map AnchoredPath ByteString -> Map AnchoredPath ByteString
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
a AnchoredPath
b)
  mModifyFilePS :: AnchoredPath
-> (ByteString -> RestrictedApply ByteString) -> RestrictedApply ()
mModifyFilePS AnchoredPath
f ByteString -> RestrictedApply ByteString
j = do Maybe ByteString
look <- (Map AnchoredPath ByteString -> Maybe ByteString)
-> StateT (Map AnchoredPath ByteString) Identity (Maybe ByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Map AnchoredPath ByteString -> Maybe ByteString)
 -> StateT
      (Map AnchoredPath ByteString) Identity (Maybe ByteString))
-> (Map AnchoredPath ByteString -> Maybe ByteString)
-> StateT (Map AnchoredPath ByteString) Identity (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> Map AnchoredPath ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AnchoredPath
f
                         case Maybe ByteString
look of
                           Maybe ByteString
Nothing -> () -> RestrictedApply ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                           Just ByteString
bits -> do
                             ByteString
new <- ByteString -> RestrictedApply ByteString
j ByteString
bits
                             (Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
-> RestrictedApply ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
 -> RestrictedApply ())
-> (Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
-> RestrictedApply ()
forall a b. (a -> b) -> a -> b
$ AnchoredPath
-> ByteString
-> Map AnchoredPath ByteString
-> Map AnchoredPath ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AnchoredPath
f ByteString
new

instance MonadProgress RestrictedApply where
  runProgressActions :: String -> [ProgressAction RestrictedApply ()] -> RestrictedApply ()
runProgressActions = String -> [ProgressAction RestrictedApply ()] -> RestrictedApply ()
forall (m :: * -> *).
Monad m =>
String -> [ProgressAction m ()] -> m ()
silentlyRunProgressActions

withFiles :: [(AnchoredPath, B.ByteString)] -> RestrictedApply a -> [(AnchoredPath, B.ByteString)]
withFiles :: [(AnchoredPath, ByteString)]
-> RestrictedApply a -> [(AnchoredPath, ByteString)]
withFiles [(AnchoredPath, ByteString)]
p RestrictedApply a
x = Map AnchoredPath ByteString -> [(AnchoredPath, ByteString)]
forall k a. Map k a -> [(k, a)]
M.toList (Map AnchoredPath ByteString -> [(AnchoredPath, ByteString)])
-> Map AnchoredPath ByteString -> [(AnchoredPath, ByteString)]
forall a b. (a -> b) -> a -> b
$ RestrictedApply a
-> Map AnchoredPath ByteString -> Map AnchoredPath ByteString
forall s a. State s a -> s -> s
execState RestrictedApply a
x (Map AnchoredPath ByteString -> Map AnchoredPath ByteString)
-> Map AnchoredPath ByteString -> Map AnchoredPath ByteString
forall a b. (a -> b) -> a -> b
$ [(AnchoredPath, ByteString)] -> Map AnchoredPath ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AnchoredPath, ByteString)]
p