module RhsCheck(checkRhs,checkBlock,checkTy) where

import Language.Haskell.Exts (parseExpWithMode, parseModuleWithMode, parseTypeWithMode, srcLine, srcColumn, srcFilename, baseFixities, glasgowExts, ParseMode (..), defaultParseMode, ParseResult (..), Extension (..))
import ErrorMessages
import Expression
import HsToken
import UU.Scanner.Position

checkRhs,checkBlock,checkTy :: Expression -> Errors
checkRhs :: Expression -> Errors
checkRhs   = forall a.
(ParseMode -> String -> ParseResult a) -> Expression -> Errors
check ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
parseExpWithMode
checkBlock :: Expression -> Errors
checkBlock = forall a.
(ParseMode -> String -> ParseResult a) -> Expression -> Errors
check ParseMode -> String -> ParseResult (Module SrcSpanInfo)
parseModuleWithMode
checkTy :: Expression -> Errors
checkTy    = forall a.
(ParseMode -> String -> ParseResult a) -> Expression -> Errors
check ParseMode -> String -> ParseResult (Type SrcSpanInfo)
parseTypeWithMode

check :: (ParseMode -> String -> ParseResult a) -> Expression -> Errors
check :: forall a.
(ParseMode -> String -> ParseResult a) -> Expression -> Errors
check ParseMode -> String -> ParseResult a
p (Expression Pos
pos [HsToken]
tks) = case ParseResult a
res of
   ParseOk a
_           -> []
   ParseFailed SrcLoc
loc String
msg -> let pos' :: Pos
pos' = Line -> Line -> String -> Pos
Pos (SrcLoc -> Line
srcLine SrcLoc
loc forall a. Num a => a -> a -> a
+ forall p. Position p => p -> Line
line Pos
pos forall a. Num a => a -> a -> a
- Line
1) (SrcLoc -> Line
srcColumn SrcLoc
loc) (SrcLoc -> String
srcFilename SrcLoc
loc)
                          in [Pos -> String -> Error
HsParseError Pos
pos' String
msg]
 where
  pos0 :: Pos
pos0 = Line -> Line -> String -> Pos
Pos (forall p. Position p => p -> Line
line Pos
pos) Line
1 (forall p. Position p => p -> String
file Pos
pos)
  str :: String
str  = Pos -> [HsToken] -> String
toString Pos
pos0 [HsToken]
tks
  res :: ParseResult a
res  = ParseMode -> String -> ParseResult a
p ParseMode
mode String
str
  bf :: Maybe [Fixity]
bf   = case [Fixity]
baseFixities of
           [] -> forall a. Maybe a
Nothing
           [Fixity]
xs -> forall a. a -> Maybe a
Just [Fixity]
xs
  mode :: ParseMode
mode = ParseMode
defaultParseMode { parseFilename :: String
parseFilename = forall p. Position p => p -> String
file Pos
pos, ignoreLanguagePragmas :: Bool
ignoreLanguagePragmas = Bool
False, extensions :: [Extension]
extensions = [Extension]
exts
                          , ignoreLinePragmas :: Bool
ignoreLinePragmas = Bool
False, fixities :: Maybe [Fixity]
fixities = Maybe [Fixity]
bf }

exts :: [Extension]
exts :: [Extension]
exts = [Extension]
glasgowExts

toString :: Pos -> HsTokens -> String
toString :: Pos -> [HsToken] -> String
toString Pos
_    []       = String
""
toString Pos
cPos (HsToken
tk:[HsToken]
tks) = String
move forall a. [a] -> [a] -> [a]
++ String
current forall a. [a] -> [a] -> [a]
++ String
next
  where
    tkPos :: Pos
tkPos   = HsToken -> Pos
getPos HsToken
tk
    move :: String
move    = Line -> Line -> Line -> String
addSpacing (forall p. Position p => p -> Line
line Pos
tkPos forall a. Num a => a -> a -> a
- forall p. Position p => p -> Line
line Pos
cPos) (forall p. Position p => p -> Line
column Pos
cPos) (forall p. Position p => p -> Line
column Pos
tkPos)
    current :: String
current = HsToken -> String
fmt HsToken
tk
    nPos :: Pos
nPos    = Pos -> String -> Pos
upd Pos
tkPos String
current
    next :: String
next    = Pos -> [HsToken] -> String
toString Pos
nPos [HsToken]
tks

getPos :: HsToken -> Pos
getPos :: HsToken -> Pos
getPos (AGLocal Identifier
_ Pos
pos Maybe String
_)    = Pos
pos
getPos (AGField Identifier
_ Identifier
_ Pos
pos Maybe String
_)  = Pos
pos
getPos (HsToken String
_ Pos
pos)      = Pos
pos
getPos (CharToken String
_ Pos
pos)    = Pos
pos
getPos (StrToken String
_ Pos
pos)     = Pos
pos
getPos (Err String
_ Pos
pos)          = Pos
pos

fmt :: HsToken -> String
fmt :: HsToken -> String
fmt (AGLocal Identifier
var Pos
_ Maybe String
_)         = String
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
var
fmt (AGField Identifier
field Identifier
attr Pos
_ Maybe String
_)  = String
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
field forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Identifier
attr
fmt (HsToken String
val Pos
_)           = String
val
fmt (CharToken String
val Pos
_)         = forall a. Show a => a -> String
show String
val
fmt (StrToken String
val Pos
_)          = forall a. Show a => a -> String
show String
val
fmt (Err String
val Pos
_)               = String
val

upd :: Pos -> String -> Pos
upd :: Pos -> String -> Pos
upd Pos
p String
s = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Pos -> Char -> Pos
adv Pos
p String
s

addSpacing :: Int -> Int -> Int -> String
addSpacing :: Line -> Line -> Line -> String
addSpacing Line
l Line
c1 Line
c2 = forall a. Line -> a -> [a]
replicate Line
l Char
'\n' forall a. [a] -> [a] -> [a]
++ forall a. Line -> a -> [a]
replicate Line
c Char
' '
  where
    c :: Line
c  | Line
l forall a. Eq a => a -> a -> Bool
== Line
0 = Line
c2 forall a. Num a => a -> a -> a
- Line
c1
       | Bool
otherwise = Line
c2 forall a. Num a => a -> a -> a
- Line
1