module UHC.Util.ScanUtils
( ScanOpts(..), defaultScanOpts
, isNoPos, posIs1stColumn
, InFilePos(..), infpStart, infpNone
, infpAdvCol, infpAdvLine, infpAdv1Line, infpAdvStr
, genTokVal, genTokTp, genTokMap
, isLF, isStr, isStrQuote
, isWhite, isBlack
, isVarStart, isVarRest
)
where
import System.IO
import Data.Char
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import UHC.Util.Pretty
import UU.Parsing
import UHC.Util.ParseUtils
import UU.Scanner.Position( noPos, Pos(..), Position(..) )
import UU.Scanner.GenToken
genTokVal :: GenToken v t v -> v
genTokVal (ValToken _ v _) = v
genTokVal (Reserved v _) = v
genTokTp :: GenToken k t v -> Maybe t
genTokTp (ValToken t _ _) = Just t
genTokTp _ = Nothing
genTokMap :: (a->b) -> GenToken a t a -> GenToken b t b
genTokMap f (ValToken t v p) = ValToken t (f v) p
genTokMap f (Reserved k p) = Reserved (f k) p
isNoPos :: Pos -> Bool
isNoPos (Pos l c f) = l < 0 || c < 0
posIs1stColumn :: Pos -> Bool
posIs1stColumn p = column p == 1
data InFilePos
= InFilePos { infpLine, infpColumn :: Int }
deriving (Eq,Ord)
instance Show InFilePos where
show (InFilePos l c) = if l < 0 || c < 0 then "" else "(" ++ show l ++ ":" ++ show c ++ ")"
infpStart :: InFilePos
infpStart = InFilePos 1 1
infpNone :: InFilePos
infpNone = InFilePos (1) (1)
infpAdvCol :: Int -> InFilePos -> InFilePos
infpAdvCol i p = p {infpColumn = i + infpColumn p}
infpAdvStr :: String -> InFilePos -> InFilePos
infpAdvStr s p = infpAdvCol (length s) p
infpAdvLine :: Int -> InFilePos -> InFilePos
infpAdvLine i p = p {infpLine = i + infpLine p, infpColumn = 1}
infpAdv1Line :: InFilePos -> InFilePos
infpAdv1Line = infpAdvLine 1
instance Position p => Position (Maybe p) where
line = maybe (line noPos) line
column = maybe (column noPos) column
file = maybe (file noPos) file
instance Position (GenToken k t v) where
line = line . position
column = column . position
file = file . position
instance PP Pos where
pp (Pos l c f) = ppParens $ (if null f then empty else pp f >|< ":" ) >|< l >|< "," >|< c
data ScanOpts
= ScanOpts
{ scoKeywordsTxt :: !(Set.Set String)
, scoPragmasTxt :: !(Map.Map String Bool)
, scoCommandsTxt :: !(Set.Set String)
, scoKeywordsOps :: !(Set.Set String)
, scoKeywExtraChars :: !(Set.Set Char)
, scoSpecChars :: !(Set.Set Char)
, scoStringDelims :: !String
, scoOpChars :: !(Set.Set Char)
, scoSpecPairs :: !(Set.Set String)
, scoDollarIdent :: !Bool
, scoOffsideTrigs :: ![String]
, scoOffsideTrigsGE :: ![String]
, scoOffsideModule :: !String
, scoOffsideOpen :: !String
, scoOffsideClose :: !String
, scoLitmode :: !Bool
, scoVerbOpenClose :: ![(String,String)]
, scoAllowQualified :: !Bool
, scoAllowFloat :: !Bool
}
defaultScanOpts :: ScanOpts
defaultScanOpts
= ScanOpts
{ scoKeywordsTxt = Set.empty
, scoPragmasTxt = Map.empty
, scoCommandsTxt = Set.empty
, scoKeywordsOps = Set.empty
, scoKeywExtraChars = Set.empty
, scoSpecChars = Set.empty
, scoStringDelims = "\""
, scoOpChars = Set.empty
, scoSpecPairs = Set.empty
, scoDollarIdent = False
, scoOffsideTrigs = []
, scoOffsideTrigsGE = []
, scoOffsideModule = ""
, scoOffsideOpen = ""
, scoOffsideClose = ""
, scoLitmode = False
, scoVerbOpenClose = []
, scoAllowQualified = True
, scoAllowFloat = True
}
isLF :: Char -> Bool
isLF = (`elem` "\n\r")
isStrQuote :: Char -> Bool
isStrQuote c = c == '"'
isStr :: Char -> Bool
isStr c = not (isStrQuote c || isLF c)
isVarStart :: Char -> Bool
isVarStart c = c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z'
isVarRest :: Char -> Bool
isVarRest c = isVarStart c || isDigit c || c `elem` "'_"
isWhite :: Char -> Bool
isWhite = (`elem` " \t")
isBlack :: Char -> Bool
isBlack c = not (isWhite c || isLF c)