-- | a 'Boomerang' library for working with '[Text]'
{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, TemplateHaskell, TypeFamilies, TypeSynonymInstances, TypeOperators #-}
module Text.Boomerang.Texts
    (
    -- * Types
      TextsError
    -- * Combinators
    , (</>), alpha, anyChar, anyText, char, digit, digits, signed, eos, integral, int
    , integer, lit, readshow, satisfy, satisfyStr, space
    , rTextCons, rEmpty, rText, rText1
    -- * Running the 'Boomerang'
    , isComplete, parseTexts, unparseTexts
    )
    where

import Prelude                    hiding ((.), id, (/))
import Control.Category           (Category((.), id))
import Data.Char                  (isAlpha, isDigit, isSpace)
import Data.String                (IsString(..))
import           Data.Text        (Text)
import qualified Data.Text        as Text
import qualified Data.Text.Read   as Text
import Text.Boomerang.Combinators (opt, duck1, manyr, somer)
import Text.Boomerang.Error       (ParserError(..),ErrorMsg(..), (<?>), condenseErrors, mkParserError)
import Text.Boomerang.HStack      ((:-)(..), arg)
import Text.Boomerang.Pos         (InitialPosition(..), MajorMinorPos(..), incMajor, incMinor)
import Text.Boomerang.Prim        (Parser(..), Boomerang(..), parse1, xmaph, xpure, unparse1, val)

type TextsError = ParserError MajorMinorPos

instance InitialPosition TextsError where
    initialPos :: Maybe TextsError -> Pos TextsError
initialPos Maybe TextsError
_ = Integer -> Integer -> MajorMinorPos
MajorMinorPos Integer
0 Integer
0

instance a ~ b => IsString (Boomerang TextsError [Text] a b) where
    fromString :: String -> Boomerang TextsError [Text] a b
fromString = Text -> Boomerang TextsError [Text] b b
forall r. Text -> Boomerang TextsError [Text] r r
lit (Text -> Boomerang TextsError [Text] b b)
-> (String -> Text) -> String -> Boomerang TextsError [Text] b b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack

-- | a constant string
lit :: Text -> Boomerang TextsError [Text] r r
lit :: Text -> Boomerang TextsError [Text] r r
lit Text
l = Parser TextsError [Text] (r -> r)
-> (r -> [([Text] -> [Text], r)])
-> Boomerang TextsError [Text] r r
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang Parser TextsError [Text] (r -> r)
pf r -> [([Text] -> [Text], r)]
sf
    where
      pf :: Parser TextsError [Text] (r -> r)
pf = ([Text]
 -> Pos TextsError
 -> [Either TextsError ((r -> r, [Text]), Pos TextsError)])
-> Parser TextsError [Text] (r -> r)
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser (([Text]
  -> Pos TextsError
  -> [Either TextsError ((r -> r, [Text]), Pos TextsError)])
 -> Parser TextsError [Text] (r -> r))
-> ([Text]
    -> Pos TextsError
    -> [Either TextsError ((r -> r, [Text]), Pos TextsError)])
-> Parser TextsError [Text] (r -> r)
forall a b. (a -> b) -> a -> b
$ \[Text]
tok Pos TextsError
pos ->
           case [Text]
tok of
             [] -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((r -> r, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect (Text -> String
forall a. Show a => a -> String
show Text
l)]
             (Text
p:[Text]
ps)
                 | Text -> Bool
Text.null Text
p Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
Text.null Text
l) -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((r -> r, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"segment", String -> ErrorMsg
Expect (Text -> String
forall a. Show a => a -> String
show Text
l)]
                 | Bool
otherwise ->
                     case Text -> Text -> Maybe Text
Text.stripPrefix Text
l Text
p of
                       (Just Text
p') ->
                           [((r -> r, [Text]), MajorMinorPos)
-> Either TextsError ((r -> r, [Text]), MajorMinorPos)
forall a b. b -> Either a b
Right ((r -> r
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, Text
p'Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ps), Int -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor (Text -> Int
Text.length Text
l) MajorMinorPos
Pos TextsError
pos)]
                       Maybe Text
Nothing ->
                           MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((r -> r, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
UnExpect (Text -> String
forall a. Show a => a -> String
show Text
p), String -> ErrorMsg
Expect (Text -> String
forall a. Show a => a -> String
show Text
l)]
      sf :: r -> [([Text] -> [Text], r)]
sf r
b = [ (\[Text]
strings -> case [Text]
strings of [] -> [Text
l] ; (Text
s:[Text]
ss) -> ((Text
l Text -> Text -> Text
`Text.append` Text
s) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ss), r
b)]

infixr 9 </>
-- | equivalent to @f . eos . g@
(</>) :: Boomerang TextsError [Text] b c -> Boomerang TextsError [Text] a b -> Boomerang TextsError [Text] a c
Boomerang TextsError [Text] b c
f </> :: Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
</> Boomerang TextsError [Text] a b
g = Boomerang TextsError [Text] b c
f Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang TextsError [Text] b b
forall r. Boomerang TextsError [Text] r r
eos Boomerang TextsError [Text] b b
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang TextsError [Text] a b
g

-- | end of string
eos :: Boomerang TextsError [Text] r r
eos :: Boomerang TextsError [Text] r r
eos = Parser TextsError [Text] (r -> r)
-> (r -> [([Text] -> [Text], r)])
-> Boomerang TextsError [Text] r r
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
       (([Text]
 -> Pos TextsError
 -> [Either TextsError ((r -> r, [Text]), Pos TextsError)])
-> Parser TextsError [Text] (r -> r)
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser (([Text]
  -> Pos TextsError
  -> [Either TextsError ((r -> r, [Text]), Pos TextsError)])
 -> Parser TextsError [Text] (r -> r))
-> ([Text]
    -> Pos TextsError
    -> [Either TextsError ((r -> r, [Text]), Pos TextsError)])
-> Parser TextsError [Text] (r -> r)
forall a b. (a -> b) -> a -> b
$ \[Text]
path Pos TextsError
pos -> case [Text]
path of
                   []      -> [((r -> r, [Text]), MajorMinorPos)
-> Either TextsError ((r -> r, [Text]), MajorMinorPos)
forall a b. b -> Either a b
Right ((r -> r
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, []), Integer -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 MajorMinorPos
Pos TextsError
pos)]
--                   [] -> mkParserError pos [EOI "input"]
                   (Text
p:[Text]
ps)
                       | Text -> Bool
Text.null Text
p ->
                          [ ((r -> r, [Text]), MajorMinorPos)
-> Either TextsError ((r -> r, [Text]), MajorMinorPos)
forall a b. b -> Either a b
Right ((r -> r
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, [Text]
ps), Integer -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 MajorMinorPos
Pos TextsError
pos) ]
                       | Bool
otherwise -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((r -> r, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
Message (String -> ErrorMsg) -> String -> ErrorMsg
forall a b. (a -> b) -> a -> b
$ String
"path-segment not entirely consumed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Text -> String
Text.unpack Text
p)])
       (\r
a -> [((Text
Text.empty Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:), r
a)])

-- | statisfy a 'Char' predicate
satisfy :: (Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
satisfy :: (Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
satisfy Char -> Bool
p = Parser TextsError [Text] Char
-> (Char -> [[Text] -> [Text]])
-> Boomerang TextsError [Text] r (Char :- r)
forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val
  (([Text]
 -> Pos TextsError
 -> [Either TextsError ((Char, [Text]), Pos TextsError)])
-> Parser TextsError [Text] Char
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser (([Text]
  -> Pos TextsError
  -> [Either TextsError ((Char, [Text]), Pos TextsError)])
 -> Parser TextsError [Text] Char)
-> ([Text]
    -> Pos TextsError
    -> [Either TextsError ((Char, [Text]), Pos TextsError)])
-> Parser TextsError [Text] Char
forall a b. (a -> b) -> a -> b
$ \[Text]
tok Pos TextsError
pos ->
       case [Text]
tok of
         []     -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((Char, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"input"]
         (Text
s:[Text]
ss) ->
             case Text -> Maybe (Char, Text)
Text.uncons Text
s of
               Maybe (Char, Text)
Nothing -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((Char, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"segment"]
               (Just (Char
c, Text
cs))
                   | Char -> Bool
p Char
c ->
                       [((Char, [Text]), MajorMinorPos)
-> Either TextsError ((Char, [Text]), MajorMinorPos)
forall a b. b -> Either a b
Right ((Char
c, Text
cs Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ss), Integer -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor Integer
1 MajorMinorPos
Pos TextsError
pos )]
                   | Bool
otherwise ->
                       MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((Char, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
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 -> [ \[Text]
paths -> case [Text]
paths of [] -> [Char -> Text
Text.singleton Char
c] ; (Text
s:[Text]
ss) -> ((Char -> Text -> Text
Text.cons Char
c Text
s)Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ss) | Char -> Bool
p Char
c ])


-- | satisfy a 'Text' predicate.
--
-- Note: must match the entire remainder of the 'Text' in this segment
satisfyStr :: (Text -> Bool) -> Boomerang TextsError [Text] r (Text :- r)
satisfyStr :: (Text -> Bool) -> Boomerang TextsError [Text] r (Text :- r)
satisfyStr Text -> Bool
p = Parser TextsError [Text] Text
-> (Text -> [[Text] -> [Text]])
-> Boomerang TextsError [Text] r (Text :- r)
forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val
  (([Text]
 -> Pos TextsError
 -> [Either TextsError ((Text, [Text]), Pos TextsError)])
-> Parser TextsError [Text] Text
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser (([Text]
  -> Pos TextsError
  -> [Either TextsError ((Text, [Text]), Pos TextsError)])
 -> Parser TextsError [Text] Text)
-> ([Text]
    -> Pos TextsError
    -> [Either TextsError ((Text, [Text]), Pos TextsError)])
-> Parser TextsError [Text] Text
forall a b. (a -> b) -> a -> b
$ \[Text]
tok Pos TextsError
pos ->
       case [Text]
tok of
         []          -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((Text, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"input"]
         (Text
s:[Text]
ss)
             | Text -> Bool
Text.null Text
s -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((Text, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"segment"]
             | Text -> Bool
p Text
s ->
                 do [((Text, [Text]), MajorMinorPos)
-> Either TextsError ((Text, [Text]), MajorMinorPos)
forall a b. b -> Either a b
Right ((Text
s, Text
Text.emptyText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ss), Integer -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMajor Integer
1 MajorMinorPos
Pos TextsError
pos )]
             | Bool
otherwise ->
                 do MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((Text, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
SysUnExpect (String -> ErrorMsg) -> String -> ErrorMsg
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
s]
  )
  (\Text
str -> [ \[Text]
strings -> case [Text]
strings of [] -> [Text
str] ; (Text
s:[Text]
ss) -> ((Text
str Text -> Text -> Text
`Text.append` Text
s)Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ss) | Text -> Bool
p Text
str ])

-- | ascii digits @\'0\'..\'9\'@
digit :: Boomerang TextsError [Text] r (Char :- r)
digit :: Boomerang TextsError [Text] r (Char :- r)
digit = (Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
forall r.
(Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
satisfy Char -> Bool
isDigit Boomerang TextsError [Text] r (Char :- r)
-> String -> Boomerang TextsError [Text] 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 :: Boomerang TextsError [Text] r (Char :- r)
alpha :: Boomerang TextsError [Text] r (Char :- r)
alpha = (Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
forall r.
(Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
satisfy Char -> Bool
isAlpha Boomerang TextsError [Text] r (Char :- r)
-> String -> Boomerang TextsError [Text] 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 :: Boomerang TextsError [Text] r (Char :- r)
space :: Boomerang TextsError [Text] r (Char :- r)
space = (Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
forall r.
(Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
satisfy Char -> Bool
isSpace Boomerang TextsError [Text] r (Char :- r)
-> String -> Boomerang TextsError [Text] 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 :: Boomerang TextsError [Text] r (Char :- r)
anyChar :: Boomerang TextsError [Text] r (Char :- r)
anyChar = (Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
forall r.
(Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | matches the specified character
char :: Char -> Boomerang TextsError [Text] r (Char :- r)
char :: Char -> Boomerang TextsError [Text] r (Char :- r)
char Char
c = (Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
forall r.
(Char -> Bool) -> Boomerang TextsError [Text] r (Char :- r)
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Boomerang TextsError [Text] r (Char :- r)
-> String -> Boomerang TextsError [Text] 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]

-- | 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 TextsError [Text] r (a :- r)
readshow :: Boomerang TextsError [Text] r (a :- r)
readshow =
    Parser TextsError [Text] a
-> (a -> [[Text] -> [Text]])
-> Boomerang TextsError [Text] r (a :- r)
forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val Parser TextsError [Text] a
forall a. Read a => Parser TextsError [Text] a
readParser a -> [[Text] -> [Text]]
forall a. Show a => a -> [[Text] -> [Text]]
s
    where
      s :: a -> [[Text] -> [Text]]
s a
a = [ \[Text]
strings -> case [Text]
strings of [] -> [String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a] ; (Text
s:[Text]
ss) -> (((String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a) Text -> Text -> Text
`Text.append` Text
s)Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ss) ]

readParser :: (Read a) => Parser TextsError [Text] a
readParser :: Parser TextsError [Text] a
readParser =
    ([Text]
 -> Pos TextsError
 -> [Either TextsError ((a, [Text]), Pos TextsError)])
-> Parser TextsError [Text] a
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser (([Text]
  -> Pos TextsError
  -> [Either TextsError ((a, [Text]), Pos TextsError)])
 -> Parser TextsError [Text] a)
-> ([Text]
    -> Pos TextsError
    -> [Either TextsError ((a, [Text]), Pos TextsError)])
-> Parser TextsError [Text] a
forall a b. (a -> b) -> a -> b
$ \[Text]
tok Pos TextsError
pos ->
        case [Text]
tok of
          []                  -> MajorMinorPos
-> [ErrorMsg] -> [Either TextsError ((a, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"input"]
          (Text
p:[Text]
_) | Text -> Bool
Text.null Text
p -> MajorMinorPos
-> [ErrorMsg] -> [Either TextsError ((a, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"segment"]
          (Text
p:[Text]
ps) ->
            case ReadS a
forall a. Read a => ReadS a
reads (Text -> String
Text.unpack Text
p) of
              [] -> MajorMinorPos
-> [ErrorMsg] -> [Either TextsError ((a, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
SysUnExpect (Text -> String
Text.unpack Text
p), String -> ErrorMsg
Message (String -> ErrorMsg) -> String -> ErrorMsg
forall a b. (a -> b) -> a -> b
$ String
"decoding using 'read' failed."]
              [(a
a,String
r)] ->
                  [((a, [Text]), MajorMinorPos)
-> Either TextsError ((a, [Text]), MajorMinorPos)
forall a b. b -> Either a b
Right ((a
a, (String -> Text
Text.pack String
r)Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ps), Int -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor ((Text -> Int
Text.length Text
p) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r)) MajorMinorPos
Pos TextsError
pos)]

readIntegral :: (Integral a) => Text -> a
readIntegral :: Text -> a
readIntegral Text
s =
    case (Reader a -> Reader a
forall a. Num a => Reader a -> Reader a
Text.signed Reader a
forall a. Integral a => Reader a
Text.decimal) Text
s of
      (Left String
e) -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"readIntegral: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
      (Right (a
a, Text
r))
          | Text -> Bool
Text.null Text
r -> a
a
          | Bool
otherwise -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"readIntegral: ambiguous parse. Left over data: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
r


-- | the empty string
rEmpty :: Boomerang e [Text] r (Text :- r)
rEmpty :: Boomerang e [Text] r (Text :- r)
rEmpty = (r -> Text :- r)
-> ((Text :- r) -> Maybe r) -> Boomerang e [Text] r (Text :- r)
forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (Text
Text.empty Text -> r -> Text :- r
forall a b. a -> b -> a :- b
:-) (((Text :- r) -> Maybe r) -> Boomerang e [Text] r (Text :- r))
-> ((Text :- r) -> Maybe r) -> Boomerang e [Text] r (Text :- r)
forall a b. (a -> b) -> a -> b
$
              \(Text
xs :- r
t) ->
                  if Text -> Bool
Text.null Text
xs
                     then (r -> Maybe r
forall a. a -> Maybe a
Just r
t)
                     else Maybe r
forall a. Maybe a
Nothing

-- | the first character of a 'Text'
rTextCons :: Boomerang e tok (Char :- Text :- r) (Text :- r)
rTextCons :: Boomerang e tok (Char :- (Text :- r)) (Text :- r)
rTextCons =
    ((Char :- (Text :- r)) -> Text :- r)
-> ((Text :- r) -> Maybe (Char :- (Text :- r)))
-> Boomerang e tok (Char :- (Text :- r)) (Text :- r)
forall a b e tok. (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure (((Text -> Text) -> (Text :- r) -> Text :- r)
-> (Char -> Text -> Text) -> (Char :- (Text :- r)) -> Text :- r
forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg ((Text -> r -> Text :- r)
-> (Text -> Text) -> (Text :- r) -> Text :- r
forall ty r s a. (ty -> r -> s) -> (a -> ty) -> (a :- r) -> s
arg Text -> r -> Text :- r
forall a b. a -> b -> a :- b
(:-)) (Char -> Text -> Text
Text.cons)) (((Text :- r) -> Maybe (Char :- (Text :- r)))
 -> Boomerang e tok (Char :- (Text :- r)) (Text :- r))
-> ((Text :- r) -> Maybe (Char :- (Text :- r)))
-> Boomerang e tok (Char :- (Text :- r)) (Text :- r)
forall a b. (a -> b) -> a -> b
$
          \(Text
xs :- r
t) ->
              do (Char
a, Text
as) <- Text -> Maybe (Char, Text)
Text.uncons Text
xs
                 (Char :- (Text :- r)) -> Maybe (Char :- (Text :- r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
a Char -> (Text :- r) -> Char :- (Text :- r)
forall a b. a -> b -> a :- b
:- Text
as Text -> r -> Text :- r
forall a b. a -> b -> a :- b
:- r
t)

-- | construct/parse some 'Text' by repeatedly apply a 'Char' 0 or more times parser
rText :: Boomerang e [Text] r (Char :- r)
      -> Boomerang e [Text] r (Text :- r)
rText :: Boomerang e [Text] r (Char :- r)
-> Boomerang e [Text] r (Text :- r)
rText Boomerang e [Text] r (Char :- r)
r = Boomerang e [Text] (Text :- r) (Text :- r)
-> Boomerang e [Text] (Text :- r) (Text :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
manyr (Boomerang e [Text] (Char :- (Text :- r)) (Text :- r)
forall e tok r. Boomerang e tok (Char :- (Text :- r)) (Text :- r)
rTextCons Boomerang e [Text] (Char :- (Text :- r)) (Text :- r)
-> Boomerang e [Text] (Text :- r) (Char :- (Text :- r))
-> Boomerang e [Text] (Text :- r) (Text :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e [Text] r (Char :- r)
-> Boomerang e [Text] (Text :- r) (Char :- (Text :- r))
forall e tok r1 a r2 h.
Boomerang e tok r1 (a :- r2)
-> Boomerang e tok (h :- r1) (a :- (h :- r2))
duck1 Boomerang e [Text] r (Char :- r)
r) Boomerang e [Text] (Text :- r) (Text :- r)
-> Boomerang e [Text] r (Text :- r)
-> Boomerang e [Text] r (Text :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e [Text] r (Text :- r)
forall e r. Boomerang e [Text] r (Text :- r)
rEmpty

-- | construct/parse some 'Text' by repeatedly apply a 'Char' 1 or more times parser
rText1 :: Boomerang e [Text] r (Char :- r)
      -> Boomerang e [Text] r (Text :- r)
rText1 :: Boomerang e [Text] r (Char :- r)
-> Boomerang e [Text] r (Text :- r)
rText1 Boomerang e [Text] r (Char :- r)
r = Boomerang e [Text] (Text :- r) (Text :- r)
-> Boomerang e [Text] (Text :- r) (Text :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
somer (Boomerang e [Text] (Char :- (Text :- r)) (Text :- r)
forall e tok r. Boomerang e tok (Char :- (Text :- r)) (Text :- r)
rTextCons Boomerang e [Text] (Char :- (Text :- r)) (Text :- r)
-> Boomerang e [Text] (Text :- r) (Char :- (Text :- r))
-> Boomerang e [Text] (Text :- r) (Text :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e [Text] r (Char :- r)
-> Boomerang e [Text] (Text :- r) (Char :- (Text :- r))
forall e tok r1 a r2 h.
Boomerang e tok r1 (a :- r2)
-> Boomerang e tok (h :- r1) (a :- (h :- r2))
duck1 Boomerang e [Text] r (Char :- r)
r) Boomerang e [Text] (Text :- r) (Text :- r)
-> Boomerang e [Text] r (Text :- r)
-> Boomerang e [Text] r (Text :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e [Text] r (Text :- r)
forall e r. Boomerang e [Text] r (Text :- r)
rEmpty


-- | a sequence of one or more digits
digits :: Boomerang TextsError [Text] r (Text :- r)
digits :: Boomerang TextsError [Text] r (Text :- r)
digits = Boomerang TextsError [Text] r (Char :- r)
-> Boomerang TextsError [Text] r (Text :- r)
forall e r.
Boomerang e [Text] r (Char :- r)
-> Boomerang e [Text] r (Text :- r)
rText1 Boomerang TextsError [Text] r (Char :- r)
forall r. Boomerang TextsError [Text] r (Char :- r)
digit

-- | an optional - character
--
-- Typically used with 'digits' to support signed numbers
--
-- > signed digits
signed :: Boomerang TextsError [Text] a (Text :- r)
       -> Boomerang TextsError [Text] a (Text :- r)
signed :: Boomerang TextsError [Text] a (Text :- r)
-> Boomerang TextsError [Text] a (Text :- r)
signed Boomerang TextsError [Text] a (Text :- r)
r = Boomerang TextsError [Text] (Text :- r) (Text :- r)
-> Boomerang TextsError [Text] (Text :- r) (Text :- r)
forall e tok r. Boomerang e tok r r -> Boomerang e tok r r
opt (Boomerang TextsError [Text] (Char :- (Text :- r)) (Text :- r)
forall e tok r. Boomerang e tok (Char :- (Text :- r)) (Text :- r)
rTextCons Boomerang TextsError [Text] (Char :- (Text :- r)) (Text :- r)
-> Boomerang TextsError [Text] (Text :- r) (Char :- (Text :- r))
-> Boomerang TextsError [Text] (Text :- r) (Text :- 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 TextsError [Text] (Text :- r) (Char :- (Text :- r))
forall r. Char -> Boomerang TextsError [Text] r (Char :- r)
char Char
'-') Boomerang TextsError [Text] (Text :- r) (Text :- r)
-> Boomerang TextsError [Text] a (Text :- r)
-> Boomerang TextsError [Text] a (Text :- r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang TextsError [Text] a (Text :- r)
r

-- | matches an 'Integral' value
--
-- Note that the combinator @(rPair . integral . integral)@ is ill-defined because the parse canwell. not tell where it is supposed to split the sequence of digits to produced two ints.
integral :: (Integral a, Show a) => Boomerang TextsError [Text] r (a :- r)
integral :: Boomerang TextsError [Text] r (a :- r)
integral = (Text -> a)
-> (a -> Maybe Text)
-> Boomerang TextsError [Text] r (Text :- r)
-> Boomerang TextsError [Text] r (a :- 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 Text -> a
forall a. Integral a => Text -> a
readIntegral (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (a -> Text) -> a -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
show)  (Boomerang TextsError [Text] r (Text :- r)
-> Boomerang TextsError [Text] r (Text :- r)
forall a r.
Boomerang TextsError [Text] a (Text :- r)
-> Boomerang TextsError [Text] a (Text :- r)
signed Boomerang TextsError [Text] r (Text :- r)
forall r. Boomerang TextsError [Text] r (Text :- r)
digits)

-- | matches an 'Int'
-- Note that the combinator @(rPair . int . int)@ is ill-defined because the parse canwell. not tell where it is supposed to split the sequence of digits to produced two ints.
int :: Boomerang TextsError [Text] r (Int :- r)
int :: Boomerang TextsError [Text] r (Int :- r)
int = Boomerang TextsError [Text] r (Int :- r)
forall a r.
(Integral a, Show a) =>
Boomerang TextsError [Text] r (a :- r)
integral

-- | 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 TextsError [Text] r (Integer :- r)
integer :: Boomerang TextsError [Text] r (Integer :- r)
integer = Boomerang TextsError [Text] r (Integer :- r)
forall a r.
(Integral a, Show a) =>
Boomerang TextsError [Text] r (a :- r)
integral

-- | matches any 'Text'
--
-- the parser returns the remainder of the current Text segment, (but does not consume the 'end of segment'.
--
-- Note that the only combinator that should follow 'anyText' is
-- 'eos' or '</>'. Other combinators will lead to inconsistent
-- inversions.
--
-- For example, if we have:
--
-- > unparseTexts (rPair . anyText . anyText)  ("foo","bar")
--
-- That will unparse to @Just ["foobar"]@. But if we call
--
-- > parseTexts (rPair . anyText . anyText)  ["foobar"]
--
-- We will get @Right ("foobar","")@ instead of the original @Right ("foo","bar")@
anyText :: Boomerang TextsError [Text] r (Text :- r)
anyText :: Boomerang TextsError [Text] r (Text :- r)
anyText = Parser TextsError [Text] Text
-> (Text -> [[Text] -> [Text]])
-> Boomerang TextsError [Text] r (Text :- r)
forall e tok a r.
Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val Parser TextsError [Text] Text
ps Text -> [[Text] -> [Text]]
ss
    where
      ps :: Parser TextsError [Text] Text
ps = ([Text]
 -> Pos TextsError
 -> [Either TextsError ((Text, [Text]), Pos TextsError)])
-> Parser TextsError [Text] Text
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser (([Text]
  -> Pos TextsError
  -> [Either TextsError ((Text, [Text]), Pos TextsError)])
 -> Parser TextsError [Text] Text)
-> ([Text]
    -> Pos TextsError
    -> [Either TextsError ((Text, [Text]), Pos TextsError)])
-> Parser TextsError [Text] Text
forall a b. (a -> b) -> a -> b
$ \[Text]
tok Pos TextsError
pos ->
           case [Text]
tok of
             []     -> MajorMinorPos
-> [ErrorMsg]
-> [Either TextsError ((Text, [Text]), MajorMinorPos)]
forall pos a. pos -> [ErrorMsg] -> [Either (ParserError pos) a]
mkParserError MajorMinorPos
Pos TextsError
pos [String -> ErrorMsg
EOI String
"input", String -> ErrorMsg
Expect String
"any string"]
--             ("":_) -> mkParserError pos [EOI "segment", Expect "any string"]
             (Text
s:[Text]
ss) -> [((Text, [Text]), MajorMinorPos)
-> Either TextsError ((Text, [Text]), MajorMinorPos)
forall a b. b -> Either a b
Right ((Text
s, Text
Text.emptyText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ss), Int -> MajorMinorPos -> MajorMinorPos
forall i. Integral i => i -> MajorMinorPos -> MajorMinorPos
incMinor (Text -> Int
Text.length Text
s) MajorMinorPos
Pos TextsError
pos)]
      ss :: Text -> [[Text] -> [Text]]
ss Text
str = [\[Text]
ss -> case [Text]
ss of
                         []      -> [Text
str]
                         (Text
s:[Text]
ss') -> ((Text
str Text -> Text -> Text
`Text.append` Text
s) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ss')
               ]

-- | Predicate to test if we have parsed all the Texts.
-- Typically used as argument to 'parse1'
--
-- see also: 'parseTexts'
isComplete :: [Text] -> Bool
isComplete :: [Text] -> Bool
isComplete []   = Bool
True
isComplete [Text
t]  = Text -> Bool
Text.null Text
t
isComplete [Text]
_    = Bool
False

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

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