-- | a 'Boomerang' library for working with a 'String'
{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, TemplateHaskell, TypeFamilies, TypeSynonymInstances, TypeOperators #-}
module Text.Boomerang.String
    (
    -- * Types
      StringBoomerang, StringPrinterParser, StringError
    -- * Combinators
    , alpha, anyChar, char, digit, int
    , integer, lit, satisfy, space
    -- * Running the 'Boomerang'
    , 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

-- | a constant string
lit :: String -> StringBoomerang r r
lit :: String -> StringBoomerang r r
lit String
l = Parser StringError String (r -> r)
-> (r -> [(String -> String, r)]) -> StringBoomerang r r
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 = (String
 -> Pos StringError
 -> [Either StringError ((r -> r, String), Pos StringError)])
-> Parser StringError String (r -> r)
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((String
  -> Pos StringError
  -> [Either StringError ((r -> r, String), Pos StringError)])
 -> Parser StringError String (r -> r))
-> (String
    -> Pos StringError
    -> [Either StringError ((r -> r, String), Pos StringError)])
-> Parser StringError String (r -> r)
forall a b. (a -> b) -> a -> b
$ \String
tok Pos StringError
pos ->
           case String
tok of
             [] -> MajorMinorPos
-> [ErrorMsg]
-> [Either StringError ((r -> r, String), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos StringError
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect (String -> String
forall a. Show a => a -> String
show String
l)]
             String
_  -> String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
forall r.
String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit String
l String
tok MajorMinorPos
Pos StringError
pos
      sf :: r -> [(String -> String, r)]
sf r
b = [ (\String
string -> (String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
string), r
b)]

parseLit :: String -> String -> MajorMinorPos -> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit :: String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit [] String
ss MajorMinorPos
pos         = [((r -> r, String), MajorMinorPos)
-> Either StringError ((r -> r, String), MajorMinorPos)
forall a b. b -> Either a b
Right ((r -> r
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, String
ss), MajorMinorPos
pos)]
parseLit (Char
l:String
_) [] MajorMinorPos
pos      = MajorMinorPos
-> [ErrorMsg]
-> [Either StringError ((r -> r, String), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect (Char -> String
forall a. Show a => a -> String
show Char
l)]
parseLit (Char
l:String
ls) (Char
s:String
ss) MajorMinorPos
pos
    | Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
s    = MajorMinorPos
-> [ErrorMsg]
-> [Either StringError ((r -> r, String), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
pos [String -> ErrorMsg
UnExpect (Char -> String
forall a. Show a => a -> String
show Char
s), String -> ErrorMsg
Expect (Char -> String
forall a. Show a => a -> String
show Char
l)]
    | Bool
otherwise = String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
forall r.
String
-> String
-> MajorMinorPos
-> [Either StringError ((r -> r, String), MajorMinorPos)]
parseLit String
ls String
ss (if Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Integer -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 MajorMinorPos
pos else Integer -> MajorMinorPos -> MajorMinorPos
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 = String -> Boomerang StringError String a b
forall r. String -> StringBoomerang r r
lit

-- | statisfy a 'Char' predicate
satisfy :: (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy :: (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
p = Parser StringError String Char
-> (Char -> [String -> String]) -> StringBoomerang r (Char :- r)
forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val
  ((String
 -> Pos StringError
 -> [Either StringError ((Char, String), Pos StringError)])
-> Parser StringError String Char
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((String
  -> Pos StringError
  -> [Either StringError ((Char, String), Pos StringError)])
 -> Parser StringError String Char)
-> (String
    -> Pos StringError
    -> [Either StringError ((Char, String), Pos StringError)])
-> Parser StringError String Char
forall a b. (a -> b) -> a -> b
$ \String
tok Pos StringError
pos ->
       case String
tok of
         []          -> MajorMinorPos
-> [ErrorMsg]
-> [Either StringError ((Char, String), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos StringError
pos [String -> ErrorMsg
EOI String
"input"]
         (Char
c:String
cs)
             | Char -> Bool
p Char
c ->
                 do [((Char, String), MajorMinorPos)
-> Either StringError ((Char, String), MajorMinorPos)
forall a b. b -> Either a b
Right ((Char
c, String
cs), if (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') then Integer -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 MajorMinorPos
Pos StringError
pos else Integer -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor Integer
1 MajorMinorPos
Pos StringError
pos)]
             | Bool
otherwise ->
                 do MajorMinorPos
-> [ErrorMsg]
-> [Either StringError ((Char, String), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos StringError
pos [String -> ErrorMsg
SysUnExpect (String -> ErrorMsg) -> String -> ErrorMsg
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
c]
  )
  (\Char
c -> [ \String
paths -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
paths) | Char -> Bool
p Char
c ])

-- | ascii digits @\'0\'..\'9\'@
digit :: StringBoomerang r (Char :- r)
digit :: StringBoomerang r (Char :- r)
digit = (Char -> Bool) -> StringBoomerang r (Char :- r)
forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
isDigit StringBoomerang r (Char :- r)
-> String -> StringBoomerang r (Char :- r)
forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String
"a digit 0-9"

-- | matches alphabetic Unicode characters (lower-case, upper-case and title-case letters,
-- plus letters of caseless scripts and modifiers letters).  (Uses 'isAlpha')
alpha :: StringBoomerang r (Char :- r)
alpha :: StringBoomerang r (Char :- r)
alpha = (Char -> Bool) -> StringBoomerang r (Char :- r)
forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
isAlpha StringBoomerang r (Char :- r)
-> String -> StringBoomerang r (Char :- r)
forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String
"an alphabetic Unicode character"

-- | matches white-space characters in the Latin-1 range. (Uses 'isSpace')
space :: StringBoomerang r (Char :- r)
space :: StringBoomerang r (Char :- r)
space = (Char -> Bool) -> StringBoomerang r (Char :- r)
forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy Char -> Bool
isSpace StringBoomerang r (Char :- r)
-> String -> StringBoomerang r (Char :- r)
forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String
"a white-space character"

-- | any character
anyChar :: StringBoomerang r (Char :- r)
anyChar :: StringBoomerang r (Char :- r)
anyChar = (Char -> Bool) -> StringBoomerang r (Char :- r)
forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | matches the specified character
char :: Char -> StringBoomerang r (Char :- r)
char :: Char -> StringBoomerang r (Char :- r)
char Char
c = (Char -> Bool) -> StringBoomerang r (Char :- r)
forall r. (Char -> Bool) -> StringBoomerang r (Char :- r)
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) StringBoomerang r (Char :- r)
-> String -> StringBoomerang r (Char :- r)
forall p tok a b.
Boomerang (ParserError p) tok a b
-> String -> Boomerang (ParserError p) tok a b
<?> String -> String
forall a. Show a => a -> String
show [Char
c]

readIntegral :: (Read a, Eq a, Num a) => String -> a
readIntegral :: String -> a
readIntegral String
s =
    case ReadS a
forall a. Read a => ReadS a
reads String
s of
      [(a
x, [])] -> a
x
      []  -> String -> a
forall a. HasCallStack => String -> a
error String
"readIntegral: no parse"
      [(a, String)]
_   -> String -> a
forall a. HasCallStack => String -> a
error String
"readIntegral: ambiguous parse"

-- | matches an 'Int'
int :: StringBoomerang r (Int :- r)
int :: StringBoomerang r (Int :- r)
int = (String -> Int)
-> (Int -> Maybe String)
-> Boomerang StringError String r (String :- r)
-> StringBoomerang r (Int :- r)
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 String -> Int
forall a. (Read a, Eq a, Num a) => String -> a
readIntegral (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> (Int -> String) -> Int -> Maybe String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> String
forall a. Show a => a -> String
show) (Boomerang StringError String (String :- r) (String :- r)
-> Boomerang StringError String (String :- r) (String :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang StringError String (Char :- (String :- r)) (String :- r)
forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons Boomerang StringError String (Char :- (String :- r)) (String :- r)
-> Boomerang
     StringError String (String :- r) (Char :- (String :- r))
-> Boomerang StringError String (String :- r) (String :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char
-> Boomerang
     StringError String (String :- r) (Char :- (String :- r))
forall r. Char -> StringBoomerang r (Char :- r)
char Char
'-') Boomerang StringError String (String :- r) (String :- r)
-> Boomerang StringError String r (String :- r)
-> Boomerang StringError String r (String :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Boomerang StringError String r (Char :- r)
-> Boomerang StringError String r (String :- r)
forall e tok r a.
Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 Boomerang StringError String r (Char :- r)
forall r. StringBoomerang r (Char :- r)
digit))

-- | matches an 'Integer'
integer :: StringBoomerang r (Integer :- r)
integer :: StringBoomerang r (Integer :- r)
integer = (String -> Integer)
-> (Integer -> Maybe String)
-> Boomerang StringError String r (String :- r)
-> StringBoomerang r (Integer :- r)
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 String -> Integer
forall a. (Read a, Eq a, Num a) => String -> a
readIntegral (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Integer -> String) -> Integer -> Maybe String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> String
forall a. Show a => a -> String
show) (Boomerang StringError String (String :- r) (String :- r)
-> Boomerang StringError String (String :- r) (String :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang StringError String (Char :- (String :- r)) (String :- r)
forall e tok a r. Boomerang e tok (a :- ([a] :- r)) ([a] :- r)
rCons Boomerang StringError String (Char :- (String :- r)) (String :- r)
-> Boomerang
     StringError String (String :- r) (Char :- (String :- r))
-> Boomerang StringError String (String :- r) (String :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char
-> Boomerang
     StringError String (String :- r) (Char :- (String :- r))
forall r. Char -> StringBoomerang r (Char :- r)
char Char
'-') Boomerang StringError String (String :- r) (String :- r)
-> Boomerang StringError String r (String :- r)
-> Boomerang StringError String r (String :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Boomerang StringError String r (Char :- r)
-> Boomerang StringError String r (String :- r)
forall e tok r a.
Boomerang e tok r (a :- r) -> Boomerang e tok r ([a] :- r)
rList1 Boomerang StringError String r (Char :- r)
forall r. StringBoomerang r (Char :- r)
digit))

-- | Predicate to test if we have parsed all the strings.
-- Typically used as argument to 'parse1'
--
-- see also: 'parseStrings'
isComplete :: String -> Bool
isComplete :: String -> Bool
isComplete = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- | run the parser
--
-- Returns the first complete parse or a parse error.
--
-- > parseString (rUnit . lit "foo") ["foo"]
parseString :: StringBoomerang () (r :- ())
             -> String
             -> Either StringError r
parseString :: StringBoomerang () (r :- ()) -> String -> Either StringError r
parseString StringBoomerang () (r :- ())
pp String
strs =
    ([StringError] -> Either StringError r)
-> (r -> Either StringError r)
-> Either [StringError] r
-> Either StringError r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (StringError -> Either StringError r
forall a b. a -> Either a b
Left (StringError -> Either StringError r)
-> ([StringError] -> StringError)
-> [StringError]
-> Either StringError r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [StringError] -> StringError
forall pos. Ord pos => [ParserError pos] -> ParserError pos
condenseErrors) r -> Either StringError r
forall a b. b -> Either a b
Right (Either [StringError] r -> Either StringError r)
-> Either [StringError] r -> Either StringError r
forall a b. (a -> b) -> a -> b
$ (String -> Bool)
-> StringBoomerang () (r :- ()) -> String -> Either [StringError] r
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

-- | run the printer
--
-- > unparseString (rUnit . lit "foo") ()
unparseString :: StringBoomerang () (r :- ()) -> r -> Maybe String
unparseString :: StringBoomerang () (r :- ()) -> r -> Maybe String
unparseString StringBoomerang () (r :- ())
pp r
r = String -> StringBoomerang () (r :- ()) -> r -> Maybe String
forall tok e a.
tok -> Boomerang e tok () (a :- ()) -> a -> Maybe tok
unparse1 [] StringBoomerang () (r :- ())
pp r
r