{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, TemplateHaskell, TypeFamilies, TypeSynonymInstances, TypeOperators #-}
module Text.Boomerang.Strings
(
StringsError
, (</>), alpha, anyChar, anyString, char, digit, eos, int
, integer, lit, readshow, satisfy, satisfyStr, space
, isComplete, parseStrings, unparseStrings
)
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 Numeric (readDec, readSigned)
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 StringsError = ParserError MajorMinorPos
instance InitialPosition StringsError where
initialPos :: Maybe StringsError -> Pos StringsError
initialPos Maybe StringsError
_ = Integer -> Integer -> MajorMinorPos
MajorMinorPos Integer
0 Integer
0
instance a ~ b => IsString (Boomerang StringsError [String] a b) where
fromString :: String -> Boomerang StringsError [String] a b
fromString = forall r. String -> Boomerang StringsError [String] r r
lit
lit :: String -> Boomerang StringsError [String] r r
lit :: forall r. String -> Boomerang StringsError [String] 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 StringsError [String] (r -> r)
pf r -> [([String] -> [String], r)]
sf
where
pf :: Parser StringsError [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 StringsError
pos ->
case [String]
tok of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect (forall a. Show a => a -> String
show String
l)]
(String
"":[String]
_) | (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l) -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"segment", String -> ErrorMsg
Expect (forall a. Show a => a -> String
show String
l)]
(String
p:[String]
ps) ->
case forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
l String
p of
(Just String
p') ->
do [forall a b. b -> Either a b
Right ((forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, String
p'forall a. a -> [a] -> [a]
:[String]
ps), forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) Pos StringsError
pos)]
Maybe String
Nothing ->
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
UnExpect (forall a. Show a => a -> String
show String
p), String -> ErrorMsg
Expect (forall a. Show a => a -> String
show String
l)]
sf :: r -> [([String] -> [String], r)]
sf r
b = [ (\[String]
strings -> case [String]
strings of [] -> [String
l] ; (String
s:[String]
ss) -> ((String
l forall a. [a] -> [a] -> [a]
++ String
s) forall a. a -> [a] -> [a]
: [String]
ss), r
b)]
infixr 9 </>
(</>) :: Boomerang StringsError [String] b c -> Boomerang StringsError [String] a b -> Boomerang StringsError [String] a c
Boomerang StringsError [String] b c
f </> :: forall b c a.
Boomerang StringsError [String] b c
-> Boomerang StringsError [String] a b
-> Boomerang StringsError [String] a c
</> Boomerang StringsError [String] a b
g = Boomerang StringsError [String] b c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Boomerang StringsError [String] r r
eos forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang StringsError [String] a b
g
eos :: Boomerang StringsError [String] r r
eos :: forall r. Boomerang StringsError [String] r r
eos = forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
(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]
path Pos StringsError
pos -> case [String]
path of
[] -> [forall a b. b -> Either a b
Right ((forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, []), forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 Pos StringsError
pos)]
(String
"":[String]
ps) ->
[ forall a b. b -> Either a b
Right ((forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, [String]
ps), forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 Pos StringsError
pos) ]
(String
p:[String]
_) -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
Message forall a b. (a -> b) -> a -> b
$ String
"path-segment not entirely consumed: " forall a. [a] -> [a] -> [a]
++ String
p])
(\r
a -> [((String
"" forall a. a -> [a] -> [a]
:), r
a)])
satisfy :: (Char -> Bool) -> Boomerang StringsError [String] r (Char :- r)
satisfy :: forall r.
(Char -> Bool) -> Boomerang StringsError [String] 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 StringsError
pos ->
case [String]
tok of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"input"]
(String
"":[String]
ss) -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"segment"]
((Char
c:String
cs):[String]
ss)
| Char -> Bool
p Char
c ->
do [forall a b. b -> Either a b
Right ((Char
c, String
cs forall a. a -> [a] -> [a]
: [String]
ss), forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor Integer
1 Pos StringsError
pos )]
| Bool
otherwise ->
do forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
SysUnExpect forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Char
c]
)
(\Char
c -> [ \[String]
paths -> case [String]
paths of [] -> [[Char
c]] ; (String
s:[String]
ss) -> ((Char
cforall a. a -> [a] -> [a]
:String
s)forall a. a -> [a] -> [a]
:[String]
ss) | Char -> Bool
p Char
c ])
satisfyStr :: (String -> Bool) -> Boomerang StringsError [String] r (String :- r)
satisfyStr :: forall r.
(String -> Bool) -> Boomerang StringsError [String] r (String :- r)
satisfyStr String -> 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 StringsError
pos ->
case [String]
tok of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"input"]
(String
"":[String]
ss) -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"segment"]
(String
s:[String]
ss)
| String -> Bool
p String
s ->
do [forall a b. b -> Either a b
Right ((String
s, String
""forall a. a -> [a] -> [a]
:[String]
ss), forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 Pos StringsError
pos )]
| Bool
otherwise ->
do forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
SysUnExpect forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
s]
)
(\String
str -> [ \[String]
strings -> case [String]
strings of [] -> [String
str] ; (String
s:[String]
ss) -> ((String
strforall a. [a] -> [a] -> [a]
++String
s)forall a. a -> [a] -> [a]
:[String]
ss) | String -> Bool
p String
str ])
digit :: Boomerang StringsError [String] r (Char :- r)
digit :: forall r. Boomerang StringsError [String] r (Char :- r)
digit = forall r.
(Char -> Bool) -> Boomerang StringsError [String] 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 :: Boomerang StringsError [String] r (Char :- r)
alpha :: forall r. Boomerang StringsError [String] r (Char :- r)
alpha = forall r.
(Char -> Bool) -> Boomerang StringsError [String] 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 :: Boomerang StringsError [String] r (Char :- r)
space :: forall r. Boomerang StringsError [String] r (Char :- r)
space = forall r.
(Char -> Bool) -> Boomerang StringsError [String] 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 :: Boomerang StringsError [String] r (Char :- r)
anyChar :: forall r. Boomerang StringsError [String] r (Char :- r)
anyChar = forall r.
(Char -> Bool) -> Boomerang StringsError [String] r (Char :- r)
satisfy (forall a b. a -> b -> a
const Bool
True)
char :: Char -> Boomerang StringsError [String] r (Char :- r)
char :: forall r. Char -> Boomerang StringsError [String] r (Char :- r)
char Char
c = forall r.
(Char -> Bool) -> Boomerang StringsError [String] 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]
readshow :: (Read a, Show a) => Boomerang StringsError [String] r (a :- r)
readshow :: forall a r.
(Read a, Show a) =>
Boomerang StringsError [String] r (a :- r)
readshow =
forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val forall a. Read a => Parser StringsError [String] a
readParser forall {a}. Show a => a -> [[String] -> [String]]
s
where
s :: a -> [[String] -> [String]]
s a
a = [ \[String]
strings -> case [String]
strings of [] -> [forall a. Show a => a -> String
show a
a] ; (String
s:[String]
ss) -> (((forall a. Show a => a -> String
show a
a)forall a. [a] -> [a] -> [a]
++String
s)forall a. a -> [a] -> [a]
:[String]
ss) ]
readParser :: (Read a) => Parser StringsError [String] a
readParser :: forall a. Read a => Parser StringsError [String] a
readParser =
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 StringsError
pos ->
case [String]
tok of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"input"]
(String
"":[String]
_) -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"segment"]
(String
p:[String]
ps) ->
case forall a. Read a => ReadS a
reads String
p of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
SysUnExpect String
p, String -> ErrorMsg
Message forall a b. (a -> b) -> a -> b
$ String
"decoding using 'read' failed."]
[(a
a,String
r)] ->
[forall a b. b -> Either a b
Right ((a
a, String
rforall a. a -> [a] -> [a]
:[String]
ps), forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor ((forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p) forall a. Num a => a -> a -> a
- (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r)) Pos StringsError
pos)]
readIntegral :: (Read a, Eq a, Num a, Real a) => String -> a
readIntegral :: forall a. (Read a, Eq a, Num a, Real a) => String -> a
readIntegral String
s =
case (forall a. Real a => ReadS a -> ReadS a
readSigned forall a. (Eq a, Num a) => ReadS a
readDec) 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 :: Boomerang StringsError [String] r (Int :- r)
int :: forall r. Boomerang StringsError [String] 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, Real 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 -> Boomerang StringsError [String] 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. Boomerang StringsError [String] r (Char :- r)
digit))
integer :: Boomerang StringsError [String] r (Integer :- r)
integer :: forall r. Boomerang StringsError [String] 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, Real 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 -> Boomerang StringsError [String] 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. Boomerang StringsError [String] r (Char :- r)
digit))
anyString :: Boomerang StringsError [String] r (String :- r)
anyString :: forall r. Boomerang StringsError [String] r (String :- r)
anyString = forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val Parser StringsError [String] String
ps forall {a}. [a] -> [[[a]] -> [[a]]]
ss
where
ps :: Parser StringsError [String] String
ps = 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 StringsError
pos ->
case [String]
tok of
[] -> forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError Pos StringsError
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect String
"any string"]
(String
s:[String]
ss) -> [forall a b. b -> Either a b
Right ((String
s, String
""forall a. a -> [a] -> [a]
:[String]
ss), forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Pos StringsError
pos)]
ss :: [a] -> [[[a]] -> [[a]]]
ss [a]
str = [\[[a]]
ss -> case [[a]]
ss of
[] -> [[a]
str]
([a]
s:[[a]]
ss') -> (([a]
str forall a. [a] -> [a] -> [a]
++ [a]
s) forall a. a -> [a] -> [a]
: [[a]]
ss')
]
isComplete :: [String] -> Bool
isComplete :: [String] -> Bool
isComplete [] = Bool
True
isComplete [String
""] = Bool
True
isComplete [String]
_ = Bool
False
parseStrings :: Boomerang StringsError [String] () (r :- ())
-> [String]
-> Either StringsError r
parseStrings :: forall r.
Boomerang StringsError [String] () (r :- ())
-> [String] -> Either StringsError r
parseStrings Boomerang StringsError [String] () (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 Boomerang StringsError [String] () (r :- ())
pp [String]
strs
unparseStrings :: Boomerang e [String] () (r :- ()) -> r -> Maybe [String]
unparseStrings :: forall e r.
Boomerang e [String] () (r :- ()) -> r -> Maybe [String]
unparseStrings Boomerang e [String] () (r :- ())
pp r
r = forall tok e a.
tok -> Boomerang e tok () (a :- ()) -> a -> Maybe tok
unparse1 [] Boomerang e [String] () (r :- ())
pp r
r