module Language.Haskell.Preprocessor.Loc (
Loc, file, line, col,
initial, bogus, isBogus,
Advance(..), scrub,
Locatable(..), cloneLoc,
toDirective, fromDirective,
toSourcePos, fromSourcePos
) where
import Data.Typeable ()
import Data.Generics
import Text.ParserCombinators.Parsec.Pos
newtype Loc = Loc { toSourcePos :: SourcePos }
deriving (Eq, Ord, Typeable)
fromSourcePos :: SourcePos -> Loc
fromSourcePos = Loc
new :: String -> Int -> Int -> Loc
new file line col = fromSourcePos (newPos file line col)
file :: Loc -> String
file = sourceName . toSourcePos
line :: Loc -> Int
line = sourceLine . toSourcePos
col :: Loc -> Int
col = sourceColumn . toSourcePos
initial :: String -> Loc
initial = fromSourcePos . initialPos
bogus :: Loc
bogus = new "<bogus>" (1) (1)
isBogus :: Loc -> Bool
isBogus loc = case (file loc, line loc, col loc) of
("<bogus>", 1, 1) -> True
_ -> False
class Advance a where
advance :: Loc -> a -> Loc
instance Advance Char where
advance loc _
| isBogus loc = loc
advance loc c = fromSourcePos (updatePosChar (toSourcePos loc) c)
instance Advance a => Advance [a] where
advance loc lst = foldl advance loc lst
class Locatable a where
getLoc :: a -> Loc
setLoc :: a -> Loc -> a
instance Locatable Loc where
getLoc = id
setLoc _ = id
instance Locatable a => Locatable (Maybe a) where
getLoc Nothing = bogus
getLoc (Just a) = getLoc a
setLoc Nothing _ = Nothing
setLoc (Just a) l = Just (setLoc a l)
instance Locatable a => Locatable [a] where
getLoc [] = bogus
getLoc (x:_) = getLoc x
setLoc [] _ = []
setLoc (x:xs) l = (setLoc x l:xs)
instance (Locatable a, Locatable b) => Locatable (Either a b) where
getLoc (Left x) = getLoc x
getLoc (Right x) = getLoc x
setLoc (Left x) l = Left (setLoc x l)
setLoc (Right x) l = Right (setLoc x l)
cloneLoc :: Locatable a => a -> a -> a
cloneLoc a b = setLoc a (getLoc b)
scrub :: Data a => a -> a
scrub a = everywhere (mkT bogosify) a where
bogosify :: Loc -> Loc
bogosify = const bogus
toDirective :: Loc -> String
toDirective loc = "# " ++ show (line loc) ++ " " ++ show (file loc)
fromDirective :: String -> Maybe Loc
fromDirective = toMaybe . parse where
toMaybe [] = Nothing
toMaybe (x:_) = Just x
parse str = do
r <- case str of
'#':' ':s -> [s]
'#':'l':'i':'n':'e':' ':s -> [s]
_ -> []
(n, r') <- reads r
(f, "") <- reads r'
return (new f n 1)
instance Show Loc where
showsPrec p loc = showsPrec p (toSourcePos loc)
tyLoc :: DataType
tyLoc = mkDataType "Language.Haskell.Preprocessor.Loc.Loc" [conLoc]
conLoc :: Constr
conLoc = mkConstr tyLoc "Loc" [] Prefix
instance Data Loc where
gfoldl f z loc = z new `f` file loc `f` line loc `f` col loc
gunfold k z c = case constrIndex c of
1 -> k (k (k (z new)))
_ -> error "gunfold"
toConstr _ = conLoc
dataTypeOf _ = tyLoc