{- CAO Compiler
Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see . -}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-
Module : $Header$
Description : Source Location
Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License : GPL
Maintainer : Paulo Silva
Stability : experimental
Portability : non-portable ()
Source location
-}
module Language.CAO.Common.SrcLoc
( -- * Source Location (point)
SrcLoc
-- * SrcLoc construction
, srcLoc
, defSrcLoc
, unkSrcLoc
, genSrcLoc
-- * Located Type
, Located(..)
-- * Located Construction
, noLoc
, genLoc
-- * Located Destruction
, getLoc
, unLoc
, mapML
) where
import Control.Monad
import Data.Foldable
import Data.Traversable
import Language.CAO.Common.Outputable
-- | Source location
--
data SrcLoc
-- | Normal Source location line:col - offset
= SrcLoc !Int -- line number
!Int -- column number
!Int -- offset
-- | General information
| UnhelpfulLoc String
deriving (Show, Read, Eq)
instance PP SrcLoc where
ppr (SrcLoc ln cn _o) = int ln <> char ':' <> int cn
ppr (UnhelpfulLoc txt) = text txt
-- | Create a 'SrcLoc'
--
{-# INLINE srcLoc #-}
srcLoc :: Int -> Int -> Int -> SrcLoc
srcLoc = SrcLoc
-- | Create default 'SrcLoc'
--
defSrcLoc :: SrcLoc
defSrcLoc = UnhelpfulLoc ""
-- | Create unknown 'SrcLoc'
--
{-# INLINE unkSrcLoc #-}
unkSrcLoc :: SrcLoc
unkSrcLoc = defSrcLoc
-- | Create generated 'SrcLoc'
--
genSrcLoc :: SrcLoc
genSrcLoc = UnhelpfulLoc ""
-- | Located element
--
data Located e = L SrcLoc e
deriving (Show, Read, Eq, Foldable, Traversable)
instance Functor Located where
fmap f (L l a) = L l (f a)
instance PP e => PP (Located e) where
ppr (L _ e) = ppr e
-- | "Unlocated" element
--
{-# INLINE noLoc #-}
noLoc :: e -> Located e
noLoc = L unkSrcLoc
-- | "Unlocated" element
--
{-# INLINE genLoc #-}
genLoc :: e -> Located e
genLoc = L genSrcLoc
-- | Get 'SrcLoc' from 'Located'
--
{-# INLINE getLoc #-}
getLoc :: Located e -> SrcLoc
getLoc (L loc _) = loc
-- | Get element in 'Located'
--
{-# INLINE unLoc #-}
unLoc :: Located e -> e
unLoc (L _ e) = e
{-# INLINE mapML #-}
mapML :: Monad m => (a -> m b) -> Located a -> m (Located b)
mapML f (L loc e) = liftM (L loc) $ f e