@@ -21,28 +21,30 @@ module Text.Parsing.Parser.Token
2121 )
2222 where
2323
24- import Data.Array as Array
25- import Data.Char.Unicode as Unicode
26- import Data.List as List
24+ import Prelude hiding (when ,between )
25+
2726import Control.Lazy (fix )
28- import Control.Monad.State (modify , gets )
27+ import Control.Monad.State (gets , modify_ )
2928import Control.MonadPlus (guard , (<|>))
29+ import Data.Array as Array
3030import Data.Char (fromCharCode , toCharCode )
3131import Data.Char.Unicode (digitToInt , isAlpha , isAlphaNum , isDigit , isHexDigit , isOctDigit , isSpace , isUpper )
32+ import Data.Char.Unicode as Unicode
3233import Data.Either (Either (..))
3334import Data.Foldable (foldl , foldr )
3435import Data.Identity (Identity )
3536import Data.Int (toNumber )
3637import Data.List (List (..))
38+ import Data.List as List
3739import Data.Maybe (Maybe (..), maybe )
38- import Data.String (toCharArray , null , toLower , fromCharArray , singleton , uncons )
40+ import Data.String (null , toLower )
41+ import Data.String.CodeUnits as SCU
3942import Data.Tuple (Tuple (..))
4043import Math (pow )
4144import Text.Parsing.Parser (ParseState (..), ParserT , fail )
4245import Text.Parsing.Parser.Combinators (skipMany1 , try , tryRethrow , skipMany , notFollowedBy , option , choice , between , sepBy1 , sepBy , (<?>), (<??>))
4346import Text.Parsing.Parser.Pos (Position )
4447import Text.Parsing.Parser.String (satisfy , oneOf , noneOf , string , char )
45- import Prelude hiding (when ,between )
4648
4749-- | Create a parser which Returns the first token in the stream.
4850token :: forall m a . Monad m => (a -> Position ) -> ParserT (List a ) m a
@@ -51,7 +53,7 @@ token tokpos = do
5153 case List .uncons input of
5254 Nothing -> fail " Unexpected EOF"
5355 Just { head, tail } -> do
54- modify \(ParseState _ position _) ->
56+ modify_ \(ParseState _ position _) ->
5557 ParseState tail (tokpos head) true
5658 pure head
5759
@@ -397,7 +399,7 @@ makeTokenParser (LanguageDef languageDef)
397399 go :: ParserT String m String
398400 go = do
399401 maybeChars <- between (char ' "' ) (char ' "' <?> " end of string" ) (List .many stringChar)
400- pure $ fromCharArray $ List .toUnfoldable $ foldr folder Nil maybeChars
402+ pure $ SCU . fromCharArray $ List .toUnfoldable $ foldr folder Nil maybeChars
401403
402404 folder :: Maybe Char -> List Char -> List Char
403405 folder Nothing chars = chars
@@ -432,7 +434,9 @@ makeTokenParser (LanguageDef languageDef)
432434 charControl = do
433435 _ <- char ' ^'
434436 code <- upper
435- pure <<< fromCharCode $ toCharCode code - toCharCode ' A' + 1
437+ case fromCharCode (toCharCode code - toCharCode ' A' + 1 ) of
438+ Just c -> pure c
439+ Nothing -> fail " invalid character code (should not happen)"
436440
437441 charNum :: ParserT String m Char
438442 charNum = do
@@ -441,7 +445,9 @@ makeTokenParser (LanguageDef languageDef)
441445 <|> ( char ' x' *> number 16 hexDigit )
442446 if code > 0x10FFFF
443447 then fail " invalid escape sequence"
444- else pure $ fromCharCode code
448+ else case fromCharCode code of
449+ Just c -> pure c
450+ Nothing -> fail " invalid character code (should not happen)"
445451
446452 charEsc :: ParserT String m Char
447453 charEsc = choice (map parseEsc escMap)
@@ -567,8 +573,8 @@ makeTokenParser (LanguageDef languageDef)
567573
568574 sign :: forall a . (Ring a ) => ParserT String m (a -> a )
569575 sign = (char ' -' $> negate)
570- <|> (char ' +' $> id )
571- <|> pure id
576+ <|> (char ' +' $> identity )
577+ <|> pure identity
572578
573579 nat :: ParserT String m Int
574580 nat = zeroNumber <|> decimal
@@ -624,7 +630,7 @@ makeTokenParser (LanguageDef languageDef)
624630 go = do
625631 c <- languageDef.opStart
626632 cs <- Array .many languageDef.opLetter
627- pure $ singleton c <> fromCharArray cs
633+ pure $ SCU . singleton c <> SCU . fromCharArray cs
628634
629635 isReservedOp :: String -> Boolean
630636 isReservedOp name = isReserved (Array .sort languageDef.reservedOpNames) name
@@ -645,7 +651,7 @@ makeTokenParser (LanguageDef languageDef)
645651 | otherwise = walk name $> name
646652 where
647653 walk :: String -> ParserT String m Unit
648- walk name' = case uncons name' of
654+ walk name' = case SCU . uncons name' of
649655 Nothing -> pure unit
650656 Just { head: c, tail: cs } -> (caseChar c <?> msg) *> walk cs
651657
@@ -675,7 +681,7 @@ makeTokenParser (LanguageDef languageDef)
675681 go = do
676682 c <- languageDef.identStart
677683 cs <- Array .many languageDef.identLetter
678- pure $ singleton c <> fromCharArray cs
684+ pure $ SCU . singleton c <> SCU . fromCharArray cs
679685
680686
681687 -- ---------------------------------------------------------
@@ -757,7 +763,7 @@ inCommentMulti langDef@(LanguageDef languageDef) =
757763 <?> " end of comment"
758764 where
759765 startEnd :: Array Char
760- startEnd = toCharArray languageDef.commentEnd <> toCharArray languageDef.commentStart
766+ startEnd = SCU . toCharArray languageDef.commentEnd <> SCU . toCharArray languageDef.commentStart
761767
762768inCommentSingle :: forall m . Monad m => GenLanguageDef String m -> ParserT String m Unit
763769inCommentSingle (LanguageDef languageDef) =
@@ -767,7 +773,7 @@ inCommentSingle (LanguageDef languageDef) =
767773 <?> " end of comment"
768774 where
769775 startEnd :: Array Char
770- startEnd = toCharArray languageDef.commentEnd <> toCharArray languageDef.commentStart
776+ startEnd = SCU . toCharArray languageDef.commentEnd <> SCU . toCharArray languageDef.commentStart
771777
772778-- -----------------------------------------------------------------------
773779-- Helper functions that should maybe go in Text.Parsing.Parser.String --
0 commit comments