module Darcs.Patch.Read
( ReadPatch(..)
, readPatch
, readPatchPartial
, bracketedFL
, peekfor
, readFileName
) where
import Darcs.Prelude
import Control.Applicative ( (<|>) )
import Control.Monad ( mzero )
import qualified Data.ByteString as B ( ByteString, null )
import qualified Data.ByteString.Char8 as BC ( ByteString, pack, stripPrefix )
import Darcs.Patch.Bracketed ( Bracketed(..), unBracketedFL )
import Darcs.Patch.Format
( FileNameFormat(..)
, ListFormat(..)
, PatchListFormat(..)
)
import Darcs.Util.Parser
( Parser
, checkConsumes
, choice
, lexChar
, lexString
, lexWord
, parse
)
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL, reverseFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal )
import Darcs.Util.ByteString ( decodeLocale, dropSpace, unpackPSFromUTF8 )
import Darcs.Util.Path ( AnchoredPath, decodeWhite, floatPath )
class ReadPatch p where
readPatch' :: Parser (Sealed (p wX))
readPatchPartial :: ReadPatch p => B.ByteString -> Either String (Sealed (p wX), B.ByteString)
readPatchPartial :: forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Either String (Sealed (p wX), ByteString)
readPatchPartial = forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
readPatch :: ReadPatch p => B.ByteString -> Either String (Sealed (p wX))
readPatch :: forall (p :: * -> * -> *) wX.
ReadPatch p =>
ByteString -> Either String (Sealed (p wX))
readPatch ByteString
ps =
case forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' ByteString
ps of
Left String
e -> forall a b. a -> Either a b
Left String
e
Right (Sealed (p wX)
p, ByteString
leftover)
| ByteString -> Bool
B.null (ByteString -> ByteString
dropSpace ByteString
leftover) -> forall a b. b -> Either a b
Right Sealed (p wX)
p
| Bool
otherwise -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"leftover:",forall a. Show a => a -> String
show ByteString
leftover]
instance ReadPatch p => ReadPatch (Bracketed p) where
readPatch' :: forall wX. Parser (Sealed (Bracketed p wX))
readPatch' = forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (p :: * -> * -> *) wX wY.
BracketedFL p wX wY -> Bracketed p wX wY
Braced forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX.
(forall wY. Parser (Sealed (p wY)))
-> Char -> Char -> Parser (Sealed (FL p wX))
bracketedFL forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' Char
'{' Char
'}'
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (p :: * -> * -> *) wX wY.
BracketedFL p wX wY -> Bracketed p wX wY
Parens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX.
(forall wY. Parser (Sealed (p wY)))
-> Char -> Char -> Parser (Sealed (FL p wX))
bracketedFL forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch' Char
'(' Char
')'
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (p :: * -> * -> *) wX wY. p wX wY -> Bracketed p wX wY
Singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
instance (ReadPatch p, PatchListFormat p) => ReadPatch (FL p) where
readPatch' :: forall wX. Parser (Sealed (FL p wX))
readPatch'
| ListFormat p
ListFormatV1 <- forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat :: ListFormat p
= forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
| ListFormat p
ListFormatV2 <- forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat :: ListFormat p
= forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
| Bool
otherwise
= forall wX. Parser (Sealed (FL p wX))
read_patches
where read_patches :: Parser (Sealed (FL p wX))
read_patches :: forall wX. Parser (Sealed (FL p wX))
read_patches = do
Maybe (Sealed (p wX))
mp <- (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
checkConsumes forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
case Maybe (Sealed (p wX))
mp of
Just (Sealed p wX wX
p) -> do
Sealed FL p wX wX
ps <- forall wX. Parser (Sealed (FL p wX))
read_patches
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wY. a wY -> Sealed a
Sealed (p wX wX
pforall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL p wX wX
ps)
Maybe (Sealed (p wX))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wY. a wY -> Sealed a
Sealed forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
instance (ReadPatch p, PatchListFormat p) => ReadPatch (RL p) where
readPatch' :: forall wX. Parser (Sealed (RL p wX))
readPatch' = forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
{-# INLINE bracketedFL #-}
bracketedFL :: forall p wX .
(forall wY . Parser (Sealed (p wY))) -> Char -> Char -> Parser (Sealed (FL p wX))
bracketedFL :: forall (p :: * -> * -> *) wX.
(forall wY. Parser (Sealed (p wY)))
-> Char -> Char -> Parser (Sealed (FL p wX))
bracketedFL forall wY. Parser (Sealed (p wY))
parser Char
pre Char
post =
forall a. Char -> Parser a -> Parser a -> Parser a
peekforc Char
pre forall wZ. Parser (Sealed (FL p wZ))
bfl forall (m :: * -> *) a. MonadPlus m => m a
mzero
where bfl :: forall wZ . Parser (Sealed (FL p wZ))
bfl :: forall wZ. Parser (Sealed (FL p wZ))
bfl = forall a. Char -> Parser a -> Parser a -> Parser a
peekforc Char
post (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wY. a wY -> Sealed a
Sealed forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
(do Sealed p wZ wX
p <- forall wY. Parser (Sealed (p wY))
parser
Sealed FL p wX wX
ps <- forall wZ. Parser (Sealed (FL p wZ))
bfl
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wY. a wY -> Sealed a
Sealed (p wZ wX
pforall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL p wX wX
ps))
{-# INLINE peekforc #-}
peekforc :: Char -> Parser a -> Parser a -> Parser a
peekforc :: forall a. Char -> Parser a -> Parser a -> Parser a
peekforc Char
c Parser a
ifstr Parser a
ifnot = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ Char -> Parser ()
lexChar Char
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
ifstr
, Parser a
ifnot ]
peekfor :: BC.ByteString -> Parser a -> Parser a -> Parser a
peekfor :: forall a. ByteString -> Parser a -> Parser a -> Parser a
peekfor ByteString
ps Parser a
ifstr Parser a
ifnot = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ do ByteString -> Parser ()
lexString ByteString
ps
Parser a
ifstr
, Parser a
ifnot ]
{-# INLINE peekfor #-}
readFileName :: FileNameFormat -> Parser AnchoredPath
readFileName :: FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt = do
ByteString
raw <- Parser ByteString
lexWord
case ByteString -> ByteString -> Maybe ByteString
BC.stripPrefix (String -> ByteString
BC.pack String
"./") ByteString
raw of
Maybe ByteString
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid file path"
Just ByteString
raw' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FileNameFormat -> ByteString -> AnchoredPath
convert FileNameFormat
fmt ByteString
raw'
where
convert :: FileNameFormat -> ByteString -> AnchoredPath
convert FileNameFormat
FileNameFormatV1 =
String -> AnchoredPath
floatPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
decodeWhite forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
decodeLocale forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpackPSFromUTF8
convert FileNameFormat
FileNameFormatV2 =
String -> AnchoredPath
floatPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
decodeWhite forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
decodeLocale
convert FileNameFormat
FileNameFormatDisplay = forall a. HasCallStack => String -> a
error String
"readFileName called with FileNameFormatDisplay"