-- | 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 :: 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

-- | statisfy a 'Char' predicate
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 ])

-- | ascii digits @\'0\'..\'9\'@
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"

-- | 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 :: 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"

-- | matches white-space characters in the Latin-1 range. (Uses 'isSpace')
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"

-- | any 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)

-- | matches the specified character
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"

-- | matches an 'Int'
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))

-- | matches an 'Integer'
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))

-- | 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 = 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 :: 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

-- | run the printer
--
-- > unparseString (rUnit . lit "foo") ()
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