-- | a 'Boomerang' library for working with '[String]'
{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, TemplateHaskell, TypeFamilies, TypeSynonymInstances, TypeOperators #-}
module Text.Boomerang.Strings
    (
    -- * Types
      StringsError
    -- * Combinators
    , (</>), alpha, anyChar, anyString, char, digit, eos, int
    , integer, lit, readshow, satisfy, satisfyStr, space
    -- * Running the 'Boomerang'
    , 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

-- | a constant string
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 </>
-- | equivalent to @f . eos . g@
(</>) :: 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

-- | end of string
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)]
--                   [] -> mkParserError pos [EOI "input"]
                   (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)])

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


-- | satisfy a 'String' predicate.
--
-- Note: must match the entire remainder of the 'String' in this segment
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 ])


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

-- | matches alphabetic Unicode characters (lower-case, upper-case and title-case letters,
-- plus letters of caseless scripts and modifiers letters).  (Uses 'isAlpha')
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"

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

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

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

-- | lift 'Read'/'Show' to a 'Boomerang'
--
-- There are a few restrictions here:
--
--  1. Error messages are a bit fuzzy. `Read` does not tell us where
--  or why a parse failed. So all we can do it use the the position
--  that we were at when we called read and say that it failed.
--
--  2. it is (currently) not safe to use 'readshow' on integral values
--  because the 'Read' instance for 'Int', 'Integer', etc,
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"

-- | matches an 'Int'
--
-- Note that the combinator @(rPair . int . int)@ is ill-defined because the parse can not tell where it is supposed to split the sequence of digits to produced two ints.
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))

-- | matches an 'Integer'
--
-- Note that the combinator @(rPair . integer . integer)@ is ill-defined because the parse can not tell where it is supposed to split the sequence of digits to produced two ints.
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))

-- | matches any 'String'
--
-- the parser returns the remainder of the current String segment, (but does not consume the 'end of segment'.
--
-- Note that the only combinator that should follow 'anyString' is
-- 'eos' or '</>'. Other combinators will lead to inconsistent
-- inversions.
--
-- For example, if we have:
--
-- > unparseStrings (rPair . anyString . anyString)  ("foo","bar")
--
-- That will unparse to @Just ["foobar"]@. But if we call
--
-- > parseStrings (rPair . anyString . anyString)  ["foobar"]
--
-- We will get @Right ("foobar","")@ instead of the original @Right ("foo","bar")@
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"]
--             ("":_) -> mkParserError pos [EOI "segment", Expect "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')
               ]

-- | 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 []   = Bool
True
isComplete [String
""] = Bool
True
isComplete [String]
_    = Bool
False

-- | run the parser
--
-- Returns the first complete parse or a parse error.
--
-- > parseStrings (rUnit . lit "foo") ["foo"]
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

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