module Darcs.Patch.Read ( ReadPatch(..),
readPatch, readPatchPartial,
bracketedFL, peekfor,
readFileName )
where
import Prelude ()
import Darcs.Prelude
import Darcs.Util.ByteString ( dropSpace, unpackPSFromUTF8, decodeLocale )
import qualified Data.ByteString as B (ByteString, null)
import Darcs.Patch.Bracketed ( Bracketed(..), unBracketedFL )
import Darcs.Util.Path ( FileName, fp2fn, decodeWhite )
import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(..), FileNameFormat(..) )
import Darcs.Patch.ReadMonads (ParserM,
parseStrictly,
choice, lexChar, lexString,
checkConsumes )
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL, reverseFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal )
import Control.Applicative ( (<|>) )
import Control.Monad ( mzero )
import qualified Data.ByteString.Char8 as BC ( ByteString, pack )
class ReadPatch p where
readPatch'
:: ParserM m => m (Sealed (p wX))
readPatchPartial :: ReadPatch p => B.ByteString -> Maybe (Sealed (p wX), B.ByteString)
readPatchPartial :: ByteString -> Maybe (Sealed (p wX), ByteString)
readPatchPartial ps :: ByteString
ps
= case SM (Sealed (p wX))
-> ByteString -> Maybe (Sealed (p wX), ByteString)
forall a. SM a -> ByteString -> Maybe (a, ByteString)
parseStrictly SM (Sealed (p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch' ByteString
ps of
Just (p :: Sealed (p wX)
p, ps' :: ByteString
ps') -> (Sealed (p wX), ByteString) -> Maybe (Sealed (p wX), ByteString)
forall a. a -> Maybe a
Just (Sealed (p wX)
p, ByteString
ps')
_ -> Maybe (Sealed (p wX), ByteString)
forall a. Maybe a
Nothing
readPatch :: ReadPatch p => B.ByteString -> Maybe (Sealed (p wX))
readPatch :: ByteString -> Maybe (Sealed (p wX))
readPatch ps :: ByteString
ps
= case ByteString -> Maybe (Sealed (p wX), ByteString)
forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Maybe (Sealed (p wX), ByteString)
readPatchPartial ByteString
ps of
Just (p :: Sealed (p wX)
p, ps' :: ByteString
ps') | ByteString -> Bool
B.null (ByteString -> ByteString
dropSpace ByteString
ps') -> Sealed (p wX) -> Maybe (Sealed (p wX))
forall a. a -> Maybe a
Just Sealed (p wX)
p
_ -> Maybe (Sealed (p wX))
forall a. Maybe a
Nothing
instance ReadPatch p => ReadPatch (Bracketed p) where
readPatch' :: m (Sealed (Bracketed p wX))
readPatch' = (forall wX. FL (Bracketed p) wX wX -> Bracketed p wX wX)
-> Sealed (FL (Bracketed p) wX) -> Sealed (Bracketed p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL (Bracketed p) wX wX -> Bracketed p wX wX
forall (p :: * -> * -> *) wX wY.
BracketedFL p wX wY -> Bracketed p wX wY
Braced (Sealed (FL (Bracketed p) wX) -> Sealed (Bracketed p wX))
-> m (Sealed (FL (Bracketed p) wX)) -> m (Sealed (Bracketed p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wY. m (Sealed (Bracketed p wY)))
-> Char -> Char -> m (Sealed (FL (Bracketed p) wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
ParserM m =>
(forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
bracketedFL forall wY. m (Sealed (Bracketed p wY))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch' '{' '}'
m (Sealed (Bracketed p wX))
-> m (Sealed (Bracketed p wX)) -> m (Sealed (Bracketed p wX))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall wX. FL (Bracketed p) wX wX -> Bracketed p wX wX)
-> Sealed (FL (Bracketed p) wX) -> Sealed (Bracketed p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL (Bracketed p) wX wX -> Bracketed p wX wX
forall (p :: * -> * -> *) wX wY.
BracketedFL p wX wY -> Bracketed p wX wY
Parens (Sealed (FL (Bracketed p) wX) -> Sealed (Bracketed p wX))
-> m (Sealed (FL (Bracketed p) wX)) -> m (Sealed (Bracketed p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wY. m (Sealed (Bracketed p wY)))
-> Char -> Char -> m (Sealed (FL (Bracketed p) wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
ParserM m =>
(forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
bracketedFL forall wY. m (Sealed (Bracketed p wY))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch' '(' ')'
m (Sealed (Bracketed p wX))
-> m (Sealed (Bracketed p wX)) -> m (Sealed (Bracketed p wX))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall wX. p wX wX -> Bracketed p wX wX)
-> Sealed (p wX) -> Sealed (Bracketed p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. p wX wX -> Bracketed p wX wX
forall (p :: * -> * -> *) wX wY. p wX wY -> Bracketed p wX wY
Singleton (Sealed (p wX) -> Sealed (Bracketed p wX))
-> m (Sealed (p wX)) -> m (Sealed (Bracketed p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
instance (ReadPatch p, PatchListFormat p) => ReadPatch (FL p) where
readPatch' :: m (Sealed (FL p wX))
readPatch'
| ListFormat p
ListFormatV1 <- ListFormat p
forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat :: ListFormat p
= (forall wX. FL (Bracketed p) wX wX -> FL p wX wX)
-> Sealed (FL (Bracketed p) wX) -> Sealed (FL p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL (Bracketed p) wX wX -> FL p wX wX
forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL (Sealed (FL (Bracketed p) wX) -> Sealed (FL p wX))
-> m (Sealed (FL (Bracketed p) wX)) -> m (Sealed (FL p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (FL (Bracketed p) wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
| ListFormat p
ListFormatV2 <- ListFormat p
forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat :: ListFormat p
= (forall wX. FL (Bracketed p) wX wX -> FL p wX wX)
-> Sealed (FL (Bracketed p) wX) -> Sealed (FL p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL (Bracketed p) wX wX -> FL p wX wX
forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL (Sealed (FL (Bracketed p) wX) -> Sealed (FL p wX))
-> m (Sealed (FL (Bracketed p) wX)) -> m (Sealed (FL p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (FL (Bracketed p) wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
| Bool
otherwise
= m (Sealed (FL p wX))
forall (m :: * -> *) wX. ParserM m => m (Sealed (FL p wX))
read_patches
where read_patches :: ParserM m => m (Sealed (FL p wX))
read_patches :: m (Sealed (FL p wX))
read_patches = do
Maybe (Sealed (p wX))
mp <- (Sealed (p wX) -> Maybe (Sealed (p wX))
forall a. a -> Maybe a
Just (Sealed (p wX) -> Maybe (Sealed (p wX)))
-> m (Sealed (p wX)) -> m (Maybe (Sealed (p wX)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (p wX)) -> m (Sealed (p wX))
forall (m :: * -> *) a. ParserM m => m a -> m a
checkConsumes m (Sealed (p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch') m (Maybe (Sealed (p wX)))
-> m (Maybe (Sealed (p wX))) -> m (Maybe (Sealed (p wX)))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Sealed (p wX)) -> m (Maybe (Sealed (p wX)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Sealed (p wX))
forall a. Maybe a
Nothing
case Maybe (Sealed (p wX))
mp of
Just (Sealed p :: p wX wX
p) -> do
Sealed ps :: FL p wX wX
ps <- m (Sealed (FL p wX))
forall (m :: * -> *) wX. ParserM m => m (Sealed (FL p wX))
read_patches
Sealed (FL p wX) -> m (Sealed (FL p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL p wX) -> m (Sealed (FL p wX)))
-> Sealed (FL p wX) -> m (Sealed (FL p wX))
forall a b. (a -> b) -> a -> b
$ FL p wX wX -> Sealed (FL p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (p wX wX
pp wX wX -> FL p wX wX -> FL p wX wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL p wX wX
ps)
Nothing -> Sealed (FL p wX) -> m (Sealed (FL p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL p wX) -> m (Sealed (FL p wX)))
-> Sealed (FL p wX) -> m (Sealed (FL p wX))
forall a b. (a -> b) -> a -> b
$ FL p wX wX -> Sealed (FL p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL p wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
instance (ReadPatch p, PatchListFormat p) => ReadPatch (RL p) where
readPatch' :: m (Sealed (RL p wX))
readPatch' = (forall wX. FL p wX wX -> RL p wX wX)
-> Sealed (FL p wX) -> Sealed (RL p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL p wX wX -> RL p wX wX
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL (Sealed (FL p wX) -> Sealed (RL p wX))
-> m (Sealed (FL p wX)) -> m (Sealed (RL p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (FL p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
{-# INLINE bracketedFL #-}
bracketedFL :: forall p m wX . (ParserM m) =>
(forall wY . m (Sealed (p wY))) -> Char -> Char -> m (Sealed (FL p wX))
bracketedFL :: (forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
bracketedFL parser :: forall wY. m (Sealed (p wY))
parser pre :: Char
pre post :: Char
post =
Char
-> m (Sealed (FL p wX))
-> m (Sealed (FL p wX))
-> m (Sealed (FL p wX))
forall (m :: * -> *) a. ParserM m => Char -> m a -> m a -> m a
peekforc Char
pre m (Sealed (FL p wX))
forall wZ. m (Sealed (FL p wZ))
bfl m (Sealed (FL p wX))
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where bfl :: forall wZ . m (Sealed (FL p wZ))
bfl :: m (Sealed (FL p wZ))
bfl = Char
-> m (Sealed (FL p wZ))
-> m (Sealed (FL p wZ))
-> m (Sealed (FL p wZ))
forall (m :: * -> *) a. ParserM m => Char -> m a -> m a -> m a
peekforc Char
post (Sealed (FL p wZ) -> m (Sealed (FL p wZ))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL p wZ) -> m (Sealed (FL p wZ)))
-> Sealed (FL p wZ) -> m (Sealed (FL p wZ))
forall a b. (a -> b) -> a -> b
$ FL p wZ wZ -> Sealed (FL p wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL p wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
(do Sealed p :: p wZ wX
p <- m (Sealed (p wZ))
forall wY. m (Sealed (p wY))
parser
Sealed ps :: FL p wX wX
ps <- m (Sealed (FL p wX))
forall wZ. m (Sealed (FL p wZ))
bfl
Sealed (FL p wZ) -> m (Sealed (FL p wZ))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (FL p wZ) -> m (Sealed (FL p wZ)))
-> Sealed (FL p wZ) -> m (Sealed (FL p wZ))
forall a b. (a -> b) -> a -> b
$ FL p wZ wX -> Sealed (FL p wZ)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (p wZ wX
pp wZ wX -> FL p wX wX -> FL p wZ wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL p wX wX
ps))
{-# INLINE peekforc #-}
peekforc :: ParserM m => Char -> m a -> m a -> m a
peekforc :: Char -> m a -> m a -> m a
peekforc c :: Char
c ifstr :: m a
ifstr ifnot :: m a
ifnot = [m a] -> m a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ Char -> m ()
forall (m :: * -> *). ParserM m => Char -> m ()
lexChar Char
c m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
ifstr
, m a
ifnot ]
peekfor :: ParserM m => BC.ByteString -> m a -> m a -> m a
peekfor :: ByteString -> m a -> m a -> m a
peekfor ps :: ByteString
ps ifstr :: m a
ifstr ifnot :: m a
ifnot = [m a] -> m a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ do ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
lexString ByteString
ps
m a
ifstr
, m a
ifnot ]
{-# INLINE peekfor #-}
readFileName :: FileNameFormat -> B.ByteString -> FileName
readFileName :: FileNameFormat -> ByteString -> FileName
readFileName OldFormat = FilePath -> FileName
fp2fn (FilePath -> FileName)
-> (ByteString -> FilePath) -> ByteString -> FileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
decodeWhite (FilePath -> FilePath)
-> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
decodeLocale (ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BC.pack (FilePath -> ByteString)
-> (ByteString -> FilePath) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
unpackPSFromUTF8
readFileName NewFormat = FilePath -> FileName
fp2fn (FilePath -> FileName)
-> (ByteString -> FilePath) -> ByteString -> FileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
decodeWhite (FilePath -> FilePath)
-> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
decodeLocale
readFileName UserFormat = FilePath -> ByteString -> FileName
forall a. HasCallStack => FilePath -> a
error "readFileName called with UserFormat"