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 = (ParseMode -> String -> ParseResult (Exp SrcSpanInfo)) -> Expression -> Errors forall a. (ParseMode -> String -> ParseResult a) -> Expression -> Errors check ParseMode -> String -> ParseResult (Exp SrcSpanInfo) parseExpWithMode checkBlock :: Expression -> Errors checkBlock = (ParseMode -> String -> ParseResult (Module SrcSpanInfo)) -> Expression -> Errors forall a. (ParseMode -> String -> ParseResult a) -> Expression -> Errors check ParseMode -> String -> ParseResult (Module SrcSpanInfo) parseModuleWithMode checkTy :: Expression -> Errors checkTy = (ParseMode -> String -> ParseResult (Type SrcSpanInfo)) -> Expression -> Errors forall a. (ParseMode -> String -> ParseResult a) -> Expression -> Errors check ParseMode -> String -> ParseResult (Type SrcSpanInfo) parseTypeWithMode check :: (ParseMode -> String -> ParseResult a) -> Expression -> Errors check :: (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 Line -> Line -> Line forall a. Num a => a -> a -> a + Pos -> Line forall p. Position p => p -> Line line Pos pos Line -> Line -> Line 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 (Pos -> Line forall p. Position p => p -> Line line Pos pos) Line 1 (Pos -> String 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 [] -> Maybe [Fixity] forall a. Maybe a Nothing [Fixity] xs -> [Fixity] -> Maybe [Fixity] forall a. a -> Maybe a Just [Fixity] xs mode :: ParseMode mode = ParseMode defaultParseMode { parseFilename :: String parseFilename = Pos -> String 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 String -> String -> String forall a. [a] -> [a] -> [a] ++ String current String -> String -> String forall a. [a] -> [a] -> [a] ++ String next where tkPos :: Pos tkPos = HsToken -> Pos getPos HsToken tk move :: String move = Line -> Line -> Line -> String addSpacing (Pos -> Line forall p. Position p => p -> Line line Pos tkPos Line -> Line -> Line forall a. Num a => a -> a -> a - Pos -> Line forall p. Position p => p -> Line line Pos cPos) (Pos -> Line forall p. Position p => p -> Line column Pos cPos) (Pos -> Line 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 "_" String -> String -> String forall a. [a] -> [a] -> [a] ++ Identifier -> String forall a. Show a => a -> String show Identifier var fmt (AGField Identifier field Identifier attr Pos _ Maybe String _) = String "_" String -> String -> String forall a. [a] -> [a] -> [a] ++ Identifier -> String forall a. Show a => a -> String show Identifier field String -> String -> String forall a. [a] -> [a] -> [a] ++ String "_" String -> String -> String forall a. [a] -> [a] -> [a] ++ Identifier -> String forall a. Show a => a -> String show Identifier attr fmt (HsToken String val Pos _) = String val fmt (CharToken String val Pos _) = String -> String forall a. Show a => a -> String show String val fmt (StrToken String val Pos _) = String -> String 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 = (Pos -> Char -> Pos) -> Pos -> String -> Pos 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 = Line -> Char -> String forall a. Line -> a -> [a] replicate Line l Char '\n' String -> String -> String forall a. [a] -> [a] -> [a] ++ Line -> Char -> String forall a. Line -> a -> [a] replicate Line c Char ' ' where c :: Line c | Line l Line -> Line -> Bool forall a. Eq a => a -> a -> Bool == Line 0 = Line c2 Line -> Line -> Line forall a. Num a => a -> a -> a - Line c1 | Bool otherwise = Line c2 Line -> Line -> Line forall a. Num a => a -> a -> a - Line 1