module HsTokenScanner where
import HsToken
import UU.Scanner.Position
import Data.List(sort)
import UU.Util.BinaryTrees
import CommonTypes
import Data.Maybe
import Data.Char

isAGesc :: Char -> Bool
isAGesc :: Char -> Bool
isAGesc Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'

lexTokens :: Options -> Pos -> String -> [HsToken]
lexTokens :: Options -> Pos -> String -> [HsToken]
lexTokens = [String]
-> [String]
-> String
-> String
-> Options
-> Pos
-> String
-> [HsToken]
scanTokens [String]
forall a. [a]
keywordstxt [String]
keywordsops String
specialchars String
opchars
  where keywordstxt :: [a]
keywordstxt   =  []
        keywordsops :: [String]
keywordsops   =  [String
".",String
"=", String
":=", String
":",String
"|",String
"@"]
        specialchars :: String
specialchars  =  String
";()[],_{}`"
        opchars :: String
opchars       =  String
"!#$%&*+./<=>?@\\^|-~:"


scanTokens :: [String] -> [String] -> String -> String -> Options -> Pos -> String -> [HsToken]
scanTokens :: [String]
-> [String]
-> String
-> String
-> Options
-> Pos
-> String
-> [HsToken]
scanTokens [String]
keywordstxt [String]
keywordsops String
specchars String
opchars Options
opts Pos
pos String
input
  = Pos -> String -> [HsToken]
doScan Pos
pos String
input

 where
   locatein :: Ord a => [a] -> a -> Bool
   locatein :: [a] -> a -> Bool
locatein [a]
es = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (a -> Maybe a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> BinSearchTree a -> a -> Maybe a
forall a b. (a -> b -> Ordering) -> BinSearchTree a -> b -> Maybe a
btLocateIn a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> BinSearchTree a
forall av. [av] -> BinSearchTree av
tab2tree ([a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
es))
   iskw :: String -> Bool
iskw     = [String] -> String -> Bool
forall a. Ord a => [a] -> a -> Bool
locatein [String]
keywordstxt
   isop :: String -> Bool
isop     = [String] -> String -> Bool
forall a. Ord a => [a] -> a -> Bool
locatein [String]
keywordsops
   isSymb :: Char -> Bool
isSymb   = String -> Char -> Bool
forall a. Ord a => [a] -> a -> Bool
locatein String
specchars
   -- See http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators

   isOpsym :: Char -> Bool
isOpsym  Char
c = String -> Char -> Bool
forall a. Ord a => [a] -> a -> Bool
locatein String
opchars Char
c
                -- For unicode operators

                Bool -> Bool -> Bool
|| (Bool -> Bool
not (Char -> Bool
isAscii Char
c) Bool -> Bool -> Bool
&& (Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c))

   isIdStart :: Char -> Bool
isIdStart Char
c = Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

   isIdChar :: Char -> Bool
isIdChar Char
c =  Char -> Bool
isAlphaNum Char
c
              Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
              Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

   scanIdent :: Pos -> String -> (String, Pos, String)
scanIdent Pos
p String
s = let (String
name,String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isIdChar String
s
                   in (String
name,Column -> Pos -> Pos
advc (String -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
length String
name) Pos
p,String
rest)

   doScan :: Pos -> String -> [HsToken]
doScan Pos
_ []      = []
   doScan Pos
p (Char
c:String
s)   | Char -> Bool
isSpace Char
c = let (String
sp,String
next) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
s
                                 in  Pos -> String -> [HsToken]
doScan ((Pos -> Char -> Pos) -> Pos -> String -> Pos
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Char -> Pos -> Pos) -> Pos -> Char -> Pos
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Pos -> Pos
updPos)  Pos
p (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
sp)) String
next
   doScan Pos
p (Char
c:Char
d:String
s) | Char -> Bool
isAGesc Char
c Bool -> Bool -> Bool
&& Char -> Bool
isIdStart Char
d =
                                 let (String
fld,Pos
p2,String
rest) = Pos -> String -> (String, Pos, String)
scanIdent (Column -> Pos -> Pos
advc Column
2 Pos
p) String
s
                                     field :: String
field = Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
fld
                                 in case String
rest of
                                      (Char
'.':Char
r:String
rs)
                                          | Char -> Bool
isIdStart Char
r -> let (String
at,Pos
p3,String
rest2) = Pos -> String -> (String, Pos, String)
scanIdent (Column -> Pos -> Pos
advc Column
2 Pos
p2) String
rs
                                                               attr :: String
attr = Char
r Char -> String -> String
forall a. a -> [a] -> [a]
: String
at
                                                           in Identifier -> Identifier -> Pos -> Maybe String -> HsToken
AGField (String -> Pos -> Identifier
Ident String
field Pos
p) (String -> Pos -> Identifier
Ident String
attr Pos
p) Pos
p Maybe String
forall a. Maybe a
Nothing HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan Pos
p3 String
rest2
                                      String
_                 -> Identifier -> Pos -> Maybe String -> HsToken
AGLocal (String -> Pos -> Identifier
Ident String
field Pos
p) Pos
p Maybe String
forall a. Maybe a
Nothing HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan Pos
p2 String
rest

   doScan Pos
p (Char
'/':Char
'/':String
s) | Options -> Bool
clean Options
opts  = Pos -> String -> [HsToken]
doScan Pos
p ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s)
   doScan Pos
p (Char
'/':Char
'*':String
s) | Options -> Bool
clean Options
opts  = Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexCleanNest Pos -> String -> [HsToken]
doScan) String
s   -- }

   doScan Pos
p (Char
'-':Char
'-':String
s)  = Pos -> String -> [HsToken]
doScan Pos
p ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s)
   doScan Pos
p (Char
'{':Char
'-':String
s)  = Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest Pos -> String -> [HsToken]
doScan) String
s   -- }

   doScan Pos
p (Char
'"':String
ss)
     = let (String
s,Column
swidth,String
rest) = String -> (String, Column, String)
scanString String
ss
       in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
rest Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'
             then String -> Pos -> HsToken
Err String
"Unterminated string literal" Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
swidth Pos
p Pos -> String -> [HsToken]
doScan String
rest
             else String -> Pos -> HsToken
StrToken String
s Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' (Column
swidthColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
2) Pos
p Pos -> String -> [HsToken]
doScan (String -> String
forall a. [a] -> [a]
tail String
rest)

   doScan Pos
p (Char
'\'':String
ss)
     | Options -> Bool
clean Options
opts = let (String
str,Column
nswidth,String
rest) = String -> (String, Column, String)
scanQualName String
ss
                    in  String -> Pos -> HsToken
HsToken (Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' (Column
nswidth Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
2) Pos
p Pos -> String -> [HsToken]
doScan (String -> String
forall a. [a] -> [a]
tail String
rest)
     | Bool
otherwise
     = let (Maybe Char
mc,Column
cwidth,String
rest) = String -> (Maybe Char, Column, String)
scanChar String
ss
       in case Maybe Char
mc of
            Maybe Char
Nothing -> String -> Pos -> HsToken
Err String
"Error in character literal" Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
cwidth Pos
p Pos -> String -> [HsToken]
doScan String
rest
            Just Char
c  -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
rest Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''
                          then String -> Pos -> HsToken
Err String
"Unterminated character literal" Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' (Column
cwidthColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1) Pos
p Pos -> String -> [HsToken]
doScan String
rest
                          else String -> Pos -> HsToken
CharToken  [Char
c] Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' (Column
cwidthColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
2) Pos
p Pos -> String -> [HsToken]
doScan (String -> String
forall a. [a] -> [a]
tail String
rest)
   doScan Pos
p cs :: String
cs@(Char
c:String
s)

     | Char -> Bool
isIdStart Char
c Bool -> Bool -> Bool
|| Char -> Bool
isUpper Char
c
         = let (String
name', Pos
p', String
s')    = Pos -> String -> (String, Pos, String)
scanIdent (Column -> Pos -> Pos
advc Column
1 Pos
p) String
s
               name :: String
name               = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
name'
               tok :: HsToken
tok                = if String -> Bool
iskw String
name
                                    then String -> Pos -> HsToken
HsToken String
name Pos
p               -- keyword

                                    else if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name' Bool -> Bool -> Bool
&& Char -> Bool
isSymb Char
c
                                    then String -> Pos -> HsToken
HsToken [Char
c] Pos
p                -- '_'

                                    else String -> Pos -> HsToken
HsToken String
name Pos
p               -- varid / conid

           in HsToken
tok HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan Pos
p' String
s'
     | Char -> Bool
isOpsym Char
c = let (String
name, String
s') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOpsym String
cs
                       tok :: HsToken
tok | String -> Bool
isop String
name = String -> Pos -> HsToken
HsToken String
name Pos
p
                           | Bool
otherwise = String -> Pos -> HsToken
HsToken String
name Pos
p
                   in HsToken
tok HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan ((Pos -> Char -> Pos) -> Pos -> String -> Pos
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Char -> Pos -> Pos) -> Pos -> Char -> Pos
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Pos -> Pos
updPos)  Pos
p String
name)  String
s'
     | Char -> Bool
isDigit Char
c = let (Column
base,String
digs,Column
width,String
s') = String -> (Column, String, Column, String)
getNumber String
cs
                       number :: String
number = case Column
base of
                          Column
8  -> String
"0o"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
digs
                          Column
10 -> String
digs
                          Column
16 -> String
"0x"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
digs
                          Column
_  -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Base " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Column -> String
forall a. Show a => a -> String
show Column
base String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not supported."
                   in  String -> Pos -> HsToken
HsToken String
number Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
width Pos
p Pos -> String -> [HsToken]
doScan String
s'
     | Char -> Bool
isSymb Char
c = String -> Pos -> HsToken
HsToken [Char
c] Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Column
-> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
1 Pos
p Pos -> String -> [HsToken]
doScan String
s
     | Bool
otherwise = String -> Pos -> HsToken
Err (String
"Unexpected character " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c) Pos
p HsToken -> [HsToken] -> [HsToken]
forall a. a -> [a] -> [a]
: Char -> Pos -> (Pos -> String -> [HsToken]) -> String -> [HsToken]
forall a. Char -> Pos -> (Pos -> a) -> a
updPos'  Char
c Pos
p Pos -> String -> [HsToken]
doScan String
s

lexNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest Pos -> String -> [HsToken]
cont Pos
pos String
inp = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
cont Pos
pos String
inp
 where lexNest' :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'{':Char
'-':String
s) = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c) (Column -> Pos -> Pos
advc Column
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'-':Char
'}':String
s) = Pos -> String -> [HsToken]
c (Column -> Pos -> Pos
advc Column
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
x:String
s)       = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c (Char -> Pos -> Pos
updPos  Char
x Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
_ Pos
_ []          = [String -> Pos -> HsToken
Err String
"Unterminated nested comment" Pos
pos]

lexCleanNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexCleanNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexCleanNest Pos -> String -> [HsToken]
cont Pos
pos String
inp = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
cont Pos
pos String
inp
 where lexNest' :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'/':Char
'*':String
s) = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c) (Column -> Pos -> Pos
advc Column
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'*':Char
'/':String
s) = Pos -> String -> [HsToken]
c (Column -> Pos -> Pos
advc Column
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
x:String
s)       = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c (Char -> Pos -> Pos
updPos  Char
x Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
_ Pos
_ []          = [String -> Pos -> HsToken
Err String
"Unterminated nested comment" Pos
pos]

scanString :: String -> (String, Int, String)
scanString :: String -> (String, Column, String)
scanString []            = (String
"",Column
0,[])
scanString (Char
'\\':Char
'&':String
xs) = let (String
str,Column
w,String
r) = String -> (String, Column, String)
scanString String
xs
                           in (String
str,Column
wColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
2,String
r)
scanString (Char
'\'':String
xs)     = let (String
str,Column
w,String
r) = String -> (String, Column, String)
scanString String
xs
                           in (Char
'\''Char -> String -> String
forall a. a -> [a] -> [a]
: String
str,Column
wColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1,String
r)
scanString String
xs = let (Maybe Char
ch,Column
cw,String
cr) = String -> (Maybe Char, Column, String)
getchar String
xs
                    (String
str,Column
w,String
r)  = String -> (String, Column, String)
scanString String
cr
--                    str' = maybe "" (:str) ch

                in (String, Column, String)
-> (Char -> (String, Column, String))
-> Maybe Char
-> (String, Column, String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"",Column
0,String
xs) (\Char
c -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
str,Column
cwColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
w,String
r)) Maybe Char
ch

scanQualName :: String -> (String, Int, String)
scanQualName :: String -> (String, Column, String)
scanQualName []          = (String
"",Column
0,[])
scanQualName r :: String
r@(Char
'\'':String
_)  = (String
"",Column
0,String
r)
scanQualName String
xs          = let (Maybe Char
ch,Column
cw,String
cr) = String -> (Maybe Char, Column, String)
getchar String
xs
                               (String
str,Column
w,String
r)  = String -> (String, Column, String)
scanQualName String
cr
                           in  (String, Column, String)
-> (Char -> (String, Column, String))
-> Maybe Char
-> (String, Column, String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"",Column
0,String
xs) (\Char
c -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
str,Column
cwColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
w,String
r)) Maybe Char
ch

scanChar :: String -> (Maybe Char, Int, String)
scanChar :: String -> (Maybe Char, Column, String)
scanChar (Char
'"' :String
xs) = (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'"',Column
1,String
xs)
scanChar String
xs        = String -> (Maybe Char, Column, String)
getchar String
xs

getchar :: String -> (Maybe Char, Int, String)
getchar :: String -> (Maybe Char, Column, String)
getchar []          = (Maybe Char
forall a. Maybe a
Nothing,Column
0,[])
getchar s :: String
s@(Char
'\n':String
_ ) = (Maybe Char
forall a. Maybe a
Nothing,Column
0,String
s )
getchar s :: String
s@(Char
'\t':String
_ ) = (Maybe Char
forall a. Maybe a
Nothing,Column
0,String
s)
getchar s :: String
s@(Char
'\'':String
_ ) = (Maybe Char
forall a. Maybe a
Nothing,Column
0,String
s)
getchar s :: String
s@(Char
'"' :String
_ ) = (Maybe Char
forall a. Maybe a
Nothing,Column
0,String
s)
getchar   (Char
'\\':String
xs) = let (Maybe Char
c,Column
l,String
r) = String -> (Maybe Char, Column, String)
getEscChar String
xs
                      in (Maybe Char
c,Column
lColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1,String
r)
getchar (Char
x:String
xs)      = (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x,Column
1,String
xs)

getEscChar :: String -> (Maybe Char, Int, String)
getEscChar :: String -> (Maybe Char, Column, String)
getEscChar [] = (Maybe Char
forall a. Maybe a
Nothing,Column
0,[])
getEscChar s :: String
s@(Char
x:String
xs) | Char -> Bool
isDigit Char
x = let (Column
base,String
n,Column
len,String
rest) = String -> (Column, String, Column, String)
getNumber String
s
                                      val :: Column
val = Column -> String -> Column
readn Column
base  String
n
                                  in  if Column
val Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
>= Column
0 Bool -> Bool -> Bool
&& Column
val Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
<= Column
255
                                         then (Char -> Maybe Char
forall a. a -> Maybe a
Just (Column -> Char
chr Column
val),Column
len, String
rest)
                                         else (Maybe Char
forall a. Maybe a
Nothing,Column
1,String
rest)
                    | Bool
otherwise = case Char
x Char -> [(Char, Char)] -> Maybe Char
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Char, Char)]
cntrChars of
                                 Maybe Char
Nothing -> (Maybe Char
forall a. Maybe a
Nothing,Column
0,String
s)
                                 Just Char
c  -> (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c,Column
1,String
xs)
  where cntrChars :: [(Char, Char)]
cntrChars = [(Char
'a',Char
'\a'),(Char
'b',Char
'\b'),(Char
'f',Char
'\f'),(Char
'n',Char
'\n'),(Char
'r',Char
'\r'),(Char
't',Char
'\t')
                    ,(Char
'v',Char
'\v'),(Char
'\\',Char
'\\'),(Char
'"',Char
'\"'),(Char
'\'',Char
'\'')]

readn :: Int -> String -> Int
readn :: Column -> String -> Column
readn Column
base String
n = (Column -> Char -> Column) -> Column -> String -> Column
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Column
r Char
x  -> Char -> Column
value Char
x Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
base Column -> Column -> Column
forall a. Num a => a -> a -> a
* Column
r) Column
0 String
n

getNumber :: String -> (Int,String,Int,String)
getNumber :: String -> (Column, String, Column, String)
getNumber [] = String -> (Column, String, Column, String)
forall a. HasCallStack => String -> a
error String
"Empty string"
getNumber cs :: String
cs@(Char
c:String
s)
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0'               = (Column, String, Column, String)
num10
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s                 = (Column, String, Column, String)
const0
  | Char
hs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
hs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'X' = (Column, String, Column, String)
num16
  | Char
hs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'o' Bool -> Bool -> Bool
|| Char
hs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'O' = (Column, String, Column, String)
num8
  | Bool
otherwise              = (Column, String, Column, String)
num10
  where (Char
hs:String
ts) = String
s
        const0 :: (Column, String, Column, String)
const0 = (Column
10, String
"0",Column
1,String
s)
        num10 :: (Column, String, Column, String)
num10  = let (String
n,String
r) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs
                 in (Column
10,String
n,String -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
length String
n,String
r)
        num16 :: (Column, String, Column, String)
num16   = (Char -> Bool)
-> String -> Column -> (Column, String, Column, String)
readNum Char -> Bool
isHexaDigit  String
ts Column
16
        num8 :: (Column, String, Column, String)
num8    = (Char -> Bool)
-> String -> Column -> (Column, String, Column, String)
readNum Char -> Bool
isOctalDigit String
ts Column
8
        readNum :: (Char -> Bool)
-> String -> Column -> (Column, String, Column, String)
readNum Char -> Bool
p String
ts' Column
tk
          = let (String
n,String
rs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
p String
ts'
            in  if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n then (Column, String, Column, String)
const0
                          else (Column
tk, String
n, Column
2Column -> Column -> Column
forall a. Num a => a -> a -> a
+String -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
length String
n,String
rs)

isHexaDigit :: Char -> Bool
isHexaDigit :: Char -> Bool
isHexaDigit  Char
d = Char -> Bool
isDigit Char
d Bool -> Bool -> Bool
|| (Char
d Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
d Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F') Bool -> Bool -> Bool
|| (Char
d Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
d Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f')
isOctalDigit :: Char -> Bool
isOctalDigit :: Char -> Bool
isOctalDigit Char
d = Char
d Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
d Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'7'

value :: Char -> Int
value :: Char -> Column
value Char
c | Char -> Bool
isDigit Char
c = Char -> Column
ord Char
c Column -> Column -> Column
forall a. Num a => a -> a -> a
- Char -> Column
ord Char
'0'
        | Char -> Bool
isUpper Char
c = Char -> Column
ord Char
c Column -> Column -> Column
forall a. Num a => a -> a -> a
- Char -> Column
ord Char
'A' Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
10
        | Char -> Bool
isLower Char
c = Char -> Column
ord Char
c Column -> Column -> Column
forall a. Num a => a -> a -> a
- Char -> Column
ord Char
'a' Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
10
value Char
_ = String -> Column
forall a. HasCallStack => String -> a
error String
"Not a valid value"