{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, TemplateHaskell, TypeFamilies, TypeSynonymInstances, TypeOperators #-}
module Text.Boomerang.String
(
StringBoomerang, StringPrinterParser, StringError
, alpha, anyChar, char, digit, int
, integer, lit, satisfy, space
, isComplete, parseString, unparseString
)
where
import Prelude hiding ((.), id, (/))
import Control.Category (Category((.), id))
import Data.Char (isAlpha, isDigit, isSpace)
import Data.Data (Data, Typeable)
import Data.List (stripPrefix)
import Data.String (IsString(..))
import Text.Boomerang.Combinators (opt, rCons, rList1)
import Text.Boomerang.Error (ParserError(..),ErrorMsg(..), (<?>), condenseErrors, mkParserError)
import Text.Boomerang.HStack ((:-)(..))
import Text.Boomerang.Pos (InitialPosition(..), MajorMinorPos(..), incMajor, incMinor)
import Text.Boomerang.Prim (Parser(..), Boomerang(..), parse1, xmaph, unparse1, val)
type StringError = ParserError MajorMinorPos
type StringBoomerang = Boomerang StringError String
type StringPrinterParser = StringBoomerang
{-# DEPRECATED StringPrinterParser "Use StringBoomerang instead" #-}
instance InitialPosition StringError where
initialPos :: Maybe StringError -> Pos StringError
initialPos Maybe StringError
_ = Integer -> Integer -> MajorMinorPos
MajorMinorPos Integer
0 Integer
0
lit :: String -> StringBoomerang r r
lit :: forall r. String -> StringBoomerang r r
lit String
l = forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang Parser StringError String (r -> r)
pf r -> [(String -> String, r)]
sf
where
pf :: Parser StringError String (r -> r)
pf = forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser forall a b. (a -> b) -> a -> b
$ \String
tok Pos StringError
pos ->
case String
tok of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringError
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect (forall a. Show a => a -> String
show String
l)]
String
_ -> forall r.
String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit String
l String
tok Pos StringError
pos
sf :: r -> [(String -> String, r)]
sf r
b = [ (\String
string -> (String
l forall a. [a] -> [a] -> [a]
++ String
string), r
b)]
parseLit :: String -> String -> MajorMinorPos -> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit :: forall r.
String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit [] String
ss MajorMinorPos
pos = [forall a b. b -> Either a b
Right ((forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, String
ss), MajorMinorPos
pos)]
parseLit (Char
l:String
_) [] MajorMinorPos
pos = forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect (forall a. Show a => a -> String
show Char
l)]
parseLit (Char
l:String
ls) (Char
s:String
ss) MajorMinorPos
pos
| Char
l forall a. Eq a => a -> a -> Bool
/= Char
s = forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
pos [String -> ErrorMsg
UnExpect (forall a. Show a => a -> String
show Char
s), String -> ErrorMsg
Expect (forall a. Show a => a -> String
show Char
l)]
| Bool
otherwise = forall r.
String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit String
ls String
ss (if Char
l forall a. Eq a => a -> a -> Bool
== Char
'\n' then forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 MajorMinorPos
pos else forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor Integer
1 MajorMinorPos
pos)
instance a ~ b => IsString (Boomerang StringError String a b) where
fromString :: String -> Boomerang StringError String a b
fromString = forall r. String -> StringBoomerang r r
lit
satisfy :: (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy :: forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
p = forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val
(forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser forall a b. (a -> b) -> a -> b
$ \String
tok Pos StringError
pos ->
case String
tok of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringError
pos [String -> ErrorMsg
EOI String
"input"]
(Char
c:String
cs)
| Char -> Bool
p Char
c ->
do [forall a b. b -> Either a b
Right ((Char
c, String
cs), if (Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n') then forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 Pos StringError
pos else forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor Integer
1 Pos StringError
pos)]
| Bool
otherwise ->
do forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringError
pos [String -> ErrorMsg
SysUnExpect forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Char
c]
)
(\Char
c -> [ \String
paths -> (Char
cforall a. a -> [a] -> [a]
:String
paths) | Char -> Bool
p Char
c ])
digit :: StringBoomerang r (Char :- r)
digit :: forall r. StringBoomerang r (Char :- r)
digit = forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
isDigit forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String
"a digit 0-9"
alpha :: StringBoomerang r (Char :- r)
alpha :: forall r. StringBoomerang r (Char :- r)
alpha = forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
isAlpha forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String
"an alphabetic Unicode character"
space :: StringBoomerang r (Char :- r)
space :: forall r. StringBoomerang r (Char :- r)
space = forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
isSpace forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String
"a white-space character"
anyChar :: StringBoomerang r (Char :- r)
anyChar :: forall r. StringBoomerang r (Char :- r)
anyChar = forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy (forall a b. a -> b -> a
const Bool
True)
char :: Char -> StringBoomerang r (Char :- r)
char :: forall r. Char -> StringBoomerang r (Char :- r)
char Char
c = forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy (forall a. Eq a => a -> a -> Bool
== Char
c) forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> forall a. Show a => a -> String
show [Char
c]
readIntegral :: (Read a, Eq a, Num a) => String -> a
readIntegral :: forall a. (Read a, Eq a, Num a) => String -> a
readIntegral String
s =
case forall a. Read a => ReadS a
reads String
s of
[(a
x, [])] -> a
x
[] -> forall a. HasCallStack => String -> a
error String
"readIntegral: no parse"
[(a, String)]
_ -> forall a. HasCallStack => String -> a
error String
"readIntegral: ambiguous parse"
int :: StringBoomerang r (Int :- r)
int :: forall r. StringBoomerang r (Int :- r)
int = forall a b e tok i o.
(a -> b)
-> (b -> Maybe a)
-> Boomerang e tok i (a :- o)
-> Boomerang e tok i (b :- o)
xmaph forall a. (Read a, Eq a, Num a) => String -> a
readIntegral (forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show) (forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Char -> StringBoomerang r (Char :- r)
char Char
'-') forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall e tok r a.
Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 forall r. StringBoomerang r (Char :- r)
digit))
integer :: StringBoomerang r (Integer :- r)
integer :: forall r. StringBoomerang r (Integer :- r)
integer = forall a b e tok i o.
(a -> b)
-> (b -> Maybe a)
-> Boomerang e tok i (a :- o)
-> Boomerang e tok i (b :- o)
xmaph forall a. (Read a, Eq a, Num a) => String -> a
readIntegral (forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show) (forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Char -> StringBoomerang r (Char :- r)
char Char
'-') forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall e tok r a.
Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 forall r. StringBoomerang r (Char :- r)
digit))
isComplete :: String -> Bool
isComplete :: String -> Bool
isComplete = forall (t :: * -> *) a. Foldable t => t a -> Bool
null
parseString :: StringBoomerang () (r :- ())
-> String
-> Either StringError r
parseString :: forall r.
StringBoomerang () (r :- ()) -> String -> Either StringError r
parseString StringBoomerang () (r :- ())
pp String
strs =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall pos. Ord pos => [ParserError pos] -> ParserError pos
condenseErrors) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall e tok a.
(ErrorPosition e, InitialPosition e, Show e, Ord (Pos e)) =>
(tok -> Bool)
-> Boomerang e tok () (a :- ()) -> tok -> Either [e] a
parse1 String -> Bool
isComplete StringBoomerang () (r :- ())
pp String
strs
unparseString :: StringBoomerang () (r :- ()) -> r -> Maybe String
unparseString :: forall r. StringBoomerang () (r :- ()) -> r -> Maybe String
unparseString StringBoomerang () (r :- ())
pp r
r = forall tok e a.
tok -> Boomerang e tok () (a :- ()) -> a -> Maybe tok
unparse1 [] StringBoomerang () (r :- ())
pp r
r