{-# OPTIONS_GHC -fno-warn-missing-methods -fno-warn-orphans #-}
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses
           , ConstraintKinds, 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 Prelude ()
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
    ( FileName, movedirfilename, fn2fp, isParentOrEqOf, floatPath, AnchoredPath )
import Control.Monad.State.Strict
import Control.Monad.Identity( Identity )
import Darcs.Patch.MonadProgress

import GHC.Exts ( Constraint )

fn2ap :: FileName -> AnchoredPath
fn2ap :: FileName -> AnchoredPath
fn2ap = FilePath -> AnchoredPath
floatPath (FilePath -> AnchoredPath)
-> (FileName -> FilePath) -> FileName -> AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> FilePath
fn2fp

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

instance ApplyMonadState Tree where
    type ApplyMonadStateOperations Tree = ApplyMonadTree

class ( Functor m, Monad m, Functor (ApplyMonadBase 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 (Functor m, 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 AnchoredPath () (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 a :: TreeMonad m x
a start :: Tree (ApplyMonadBase (TreeMonad m))
start = m (x, Tree m)
-> TreeMonad m (x, Tree (ApplyMonadBase (TreeMonad m)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (x, Tree m)
 -> TreeMonad m (x, Tree (ApplyMonadBase (TreeMonad m))))
-> m (x, Tree m)
-> TreeMonad m (x, Tree (ApplyMonadBase (TreeMonad 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 a :: Tree (ApplyMonadBase (TreeMonad m))
-> ApplyMonadBase (TreeMonad m) x
a start :: Tree (ApplyMonadBase (TreeMonad m))
start = do Tree m
x <- (TreeState m -> Tree m)
-> RWST AnchoredPath () (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 AnchoredPath () (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 AnchoredPath () (TreeState m) m (x, Tree m))
-> m (x, Tree m)
-> RWST AnchoredPath () (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 -> ApplyMonadOver Tree m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m x -> ApplyMonadOver Tree m x) -> m x -> ApplyMonadOver Tree 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 (Functor m, Monad m) => ApplyMonadTree (TM.TreeMonad m) where

    mDoesDirectoryExist :: FileName -> TreeMonad m Bool
mDoesDirectoryExist d :: FileName
d = AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). TreeRO m => AnchoredPath -> m Bool
TM.directoryExists (FileName -> AnchoredPath
fn2ap FileName
d)
    mDoesFileExist :: FileName -> TreeMonad m Bool
mDoesFileExist d :: FileName
d = AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). TreeRO m => AnchoredPath -> m Bool
TM.fileExists (FileName -> AnchoredPath
fn2ap FileName
d)
    mReadFilePS :: FileName -> TreeMonad m ByteString
mReadFilePS p :: FileName
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 AnchoredPath () (TreeState m) m ByteString
-> TreeMonad m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AnchoredPath -> RWST AnchoredPath () (TreeState m) m ByteString
forall (m :: * -> *). TreeRO m => AnchoredPath -> m ByteString
TM.readFile (FileName -> AnchoredPath
fn2ap FileName
p)
    mModifyFilePS :: FileName
-> (ByteString -> TreeMonad m ByteString) -> TreeMonad m ()
mModifyFilePS p :: FileName
p j :: ByteString -> TreeMonad m ByteString
j = do Bool
have <- AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). TreeRO m => AnchoredPath -> m Bool
TM.fileExists (FileName -> AnchoredPath
fn2ap FileName
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 AnchoredPath () (TreeState m) m ByteString
-> TreeMonad m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AnchoredPath -> RWST AnchoredPath () (TreeState m) m ByteString
forall (m :: * -> *). TreeRO m => AnchoredPath -> m ByteString
TM.readFile (FileName -> AnchoredPath
fn2ap FileName
p)
                                        else ByteString -> TreeMonad m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
                           AnchoredPath -> ByteString -> TreeMonad m ()
forall (m :: * -> *).
TreeRW m =>
AnchoredPath -> ByteString -> m ()
TM.writeFile (FileName -> AnchoredPath
fn2ap FileName
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 :: FileName -> TreeMonad m ()
mCreateDirectory p :: FileName
p = AnchoredPath -> TreeMonad m ()
forall (m :: * -> *). TreeRW m => AnchoredPath -> m ()
TM.createDirectory (FileName -> AnchoredPath
fn2ap FileName
p)
    mRename :: FileName -> FileName -> TreeMonad m ()
mRename from :: FileName
from to :: FileName
to = AnchoredPath -> AnchoredPath -> TreeMonad m ()
forall (m :: * -> *).
TreeRW m =>
AnchoredPath -> AnchoredPath -> m ()
TM.rename (FileName -> AnchoredPath
fn2ap FileName
from) (FileName -> AnchoredPath
fn2ap FileName
to)
    mRemoveDirectory :: FileName -> TreeMonad m ()
mRemoveDirectory = AnchoredPath -> TreeMonad m ()
forall (m :: * -> *). TreeRW m => AnchoredPath -> m ()
TM.unlink (AnchoredPath -> TreeMonad m ())
-> (FileName -> AnchoredPath) -> FileName -> TreeMonad m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> AnchoredPath
fn2ap
    mRemoveFile :: FileName -> TreeMonad m ()
mRemoveFile = AnchoredPath -> TreeMonad m ()
forall (m :: * -> *). TreeRW m => AnchoredPath -> m ()
TM.unlink (AnchoredPath -> TreeMonad m ())
-> (FileName -> AnchoredPath) -> FileName -> TreeMonad m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileName -> AnchoredPath
fn2ap

-- Latest name, current original name.
type OrigFileNameOf = (FileName, FileName)
-- Touched files, new file list (after removes etc.) and rename details
type FilePathMonadState = ([FileName], [FileName], [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 :: FileName -> FileName -> OrigFileNameOf -> OrigFileNameOf
trackOrigRename :: FileName -> FileName -> OrigFileNameOf -> OrigFileNameOf
trackOrigRename old :: FileName
old new :: FileName
new pair :: OrigFileNameOf
pair@(latest :: FileName
latest, from :: FileName
from)
    | FileName
old FileName -> FileName -> Bool
`isParentOrEqOf` FileName
latest = (FileName
latest, FileName -> FileName -> FileName -> FileName
movedirfilename FileName
old FileName
new FileName
latest)
    | FileName
old FileName -> FileName -> Bool
`isParentOrEqOf` FileName
from = (FileName
latest, FileName -> FileName -> FileName -> FileName
movedirfilename FileName
old FileName
new FileName
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] -> [FileName] -> FilePathMonad a
    -> FilePathMonadState
withFileNames :: Maybe [OrigFileNameOf]
-> [FileName] -> FilePathMonad a -> FilePathMonadState
withFileNames mbofnos :: Maybe [OrigFileNameOf]
mbofnos fps :: [FileName]
fps x :: FilePathMonad a
x = FilePathMonad a -> FilePathMonadState -> FilePathMonadState
forall s a. State s a -> s -> s
execState FilePathMonad a
x ([], [FileName]
fps, [OrigFileNameOf]
ofnos) where
    ofnos :: [OrigFileNameOf]
ofnos = [OrigFileNameOf] -> Maybe [OrigFileNameOf] -> [OrigFileNameOf]
forall a. a -> Maybe a -> a
fromMaybe ((FileName -> OrigFileNameOf) -> [FileName] -> [OrigFileNameOf]
forall a b. (a -> b) -> [a] -> [b]
map (\y :: FileName
y -> (FileName
y, FileName
y)) [FileName]
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 :: FileName -> FilePathMonad Bool
mDoesDirectoryExist d :: FileName
d = (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
$ \(_, fs :: [FileName]
fs, _) -> FileName
d FileName -> [FileName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FileName]
fs

    mCreateDirectory :: FileName -> FilePathMonad ()
mCreateDirectory = FileName -> FilePathMonad ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mCreateFile
    mCreateFile :: FileName -> FilePathMonad ()
mCreateFile f :: FileName
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
$ \(ms :: [FileName]
ms, fs :: [FileName]
fs, rns :: [OrigFileNameOf]
rns) -> (FileName
f FileName -> [FileName] -> [FileName]
forall a. a -> [a] -> [a]
: [FileName]
ms, [FileName]
fs, [OrigFileNameOf]
rns)
    mRemoveFile :: FileName -> FilePathMonad ()
mRemoveFile f :: FileName
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
$ \(ms :: [FileName]
ms, fs :: [FileName]
fs, rns :: [OrigFileNameOf]
rns) -> (FileName
f FileName -> [FileName] -> [FileName]
forall a. a -> [a] -> [a]
: [FileName]
ms, (FileName -> Bool) -> [FileName] -> [FileName]
forall a. (a -> Bool) -> [a] -> [a]
filter (FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
/= FileName
f) [FileName]
fs, [OrigFileNameOf]
rns)
    mRemoveDirectory :: FileName -> FilePathMonad ()
mRemoveDirectory = FileName -> FilePathMonad ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mRemoveFile
    mRename :: FileName -> FileName -> FilePathMonad ()
mRename a :: FileName
a b :: FileName
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
$ \(ms :: [FileName]
ms, fs :: [FileName]
fs, rns :: [OrigFileNameOf]
rns) -> ( FileName
a FileName -> [FileName] -> [FileName]
forall a. a -> [a] -> [a]
: FileName
b FileName -> [FileName] -> [FileName]
forall a. a -> [a] -> [a]
: [FileName]
ms
                                   , (FileName -> FileName) -> [FileName] -> [FileName]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> FileName -> FileName -> FileName
movedirfilename FileName
a FileName
b) [FileName]
fs
                                   , (OrigFileNameOf -> OrigFileNameOf)
-> [OrigFileNameOf] -> [OrigFileNameOf]
forall a b. (a -> b) -> [a] -> [b]
map (FileName -> FileName -> OrigFileNameOf -> OrigFileNameOf
trackOrigRename FileName
a FileName
b) [OrigFileNameOf]
rns)
    mModifyFilePS :: FileName
-> (ByteString -> FilePathMonad ByteString) -> FilePathMonad ()
mModifyFilePS f :: FileName
f _ = FileName -> FilePathMonad ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mCreateFile FileName
f

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

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

instance ApplyMonad Tree RestrictedApply where
  type ApplyMonadBase RestrictedApply = Identity

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

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

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