    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Position
    -- Copyright   :  2000-2004 Malcolm Wallace
    -- Licence     :  LGPL
    --
    -- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
    -- Stability   :  experimental
    -- Portability :  All
    --
    -- Simple file position information, with recursive inclusion points.
    -----------------------------------------------------------------------------

    module Language.Preprocessor.Cpphs.Position
      ( Posn(..)
      , newfile
      , addcol, newline, tab, newlines, newpos
      , cppline, haskline, cpp2hask
      , filename, lineno, directory
      , cleanPath
      ) where

    import Data.List (isPrefixOf)

    -- | Source positions contain a filename, line, column, and an
    --   inclusion point, which is itself another source position,
    --   recursively.
    data Posn = Pn String !Int !Int (Maybe Posn)
            deriving (Posn -> Posn -> Bool
    (Posn -> Posn -> Bool) -> (Posn -> Posn -> Bool) -> Eq Posn
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Posn -> Posn -> Bool
    == :: Posn -> Posn -> Bool
    $c/= :: Posn -> Posn -> Bool
    /= :: Posn -> Posn -> Bool
    Eq)

    instance Show Posn where
          showsPrec :: Int -> Posn -> ShowS
    showsPrec Int
    _ (Pn String
    f Int
    l Int
    c Maybe Posn
    i) = String -> ShowS
    showString String
    f ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                     String -> ShowS
    showString String
    "  at line " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    l ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                     String -> ShowS
    showString String
    " col " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                     ( case Maybe Posn
    i of
                                        Maybe Posn
    Nothing -> ShowS
    forall a. a -> a
    id
                                        Just Posn
    p  -> String -> ShowS
    showString String
    "\n    used by  " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                                   Posn -> ShowS
    forall a. Show a => a -> ShowS
    shows Posn
    p )

    -- | Constructor.  Argument is filename.
    newfile :: String -> Posn
    newfile :: String -> Posn
    newfile String
    name = String -> Int -> Int -> Maybe Posn -> Posn
    Pn (ShowS
    cleanPath String
    name) Int
    1 Int
    1 Maybe Posn
    forall a. Maybe a
    Nothing

    -- | Increment column number by given quantity.
    addcol :: Int -> Posn -> Posn
    addcol :: Int -> Posn -> Posn
    addcol Int
    n (Pn String
    f Int
    r Int
    c Maybe Posn
    i) = String -> Int -> Int -> Maybe Posn -> Posn
    Pn String
    f Int
    r (Int
    cInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n) Maybe Posn
    i

    -- | Increment row number, reset column to 1.
    newline :: Posn -> Posn
    --newline (Pn f r _ i) = Pn f (r+1) 1 i
    newline :: Posn -> Posn
    newline (Pn String
    f Int
    r Int
    _ Maybe Posn
    i) = let r' :: Int
    r' = Int
    rInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1 in Int
    r' Int -> Posn -> Posn
    forall a b. a -> b -> b
    `seq` String -> Int -> Int -> Maybe Posn -> Posn
    Pn String
    f Int
    r' Int
    1 Maybe Posn
    i

    -- | Increment column number, tab stops are every 8 chars.
    tab     :: Posn -> Posn
    tab :: Posn -> Posn
    tab     (Pn String
    f Int
    r Int
    c Maybe Posn
    i) = String -> Int -> Int -> Maybe Posn -> Posn
    Pn String
    f Int
    r (((Int
    cInt -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div`Int
    8)Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    8) Maybe Posn
    i

    -- | Increment row number by given quantity.
    newlines :: Int -> Posn -> Posn
    newlines :: Int -> Posn -> Posn
    newlines Int
    n (Pn String
    f Int
    r Int
    _ Maybe Posn
    i) = String -> Int -> Int -> Maybe Posn -> Posn
    Pn String
    f (Int
    rInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n) Int
    1 Maybe Posn
    i

    -- | Update position with a new row, and possible filename.
    newpos :: Int -> Maybe String -> Posn -> Posn
    newpos :: Int -> Maybe String -> Posn -> Posn
    newpos Int
    r Maybe String
    Nothing  (Pn String
    f Int
    _ Int
    c Maybe Posn
    i) = String -> Int -> Int -> Maybe Posn -> Posn
    Pn String
    f Int
    r Int
    c Maybe Posn
    i
    newpos Int
    r (Just (Char
    '"':String
    f)) (Pn String
    _ Int
    _ Int
    c Maybe Posn
    i) = String -> Int -> Int -> Maybe Posn -> Posn
    Pn (ShowS
    forall a. HasCallStack => [a] -> [a]
    init String
    f) Int
    r Int
    c Maybe Posn
    i
    newpos Int
    r (Just String
    f)       (Pn String
    _ Int
    _ Int
    c Maybe Posn
    i) = String -> Int -> Int -> Maybe Posn -> Posn
    Pn String
    f Int
    r Int
    c Maybe Posn
    i

    -- | Project the line number.
    lineno    :: Posn -> Int
    -- | Project the filename.
    filename  :: Posn -> String
    -- | Project the directory of the filename.
    directory :: Posn -> FilePath

    lineno :: Posn -> Int
    lineno    (Pn String
    _ Int
    r Int
    _ Maybe Posn
    _) = Int
    r
    filename :: Posn -> String
    filename  (Pn String
    f Int
    _ Int
    _ Maybe Posn
    _) = String
    f
    directory :: Posn -> String
    directory (Pn String
    f Int
    _ Int
    _ Maybe Posn
    _) = ShowS
    dirname String
    f

    -- | cpp-style printing of file position
    cppline :: Posn -> String
    cppline :: Posn -> String
    cppline (Pn String
    f Int
    r Int
    _ Maybe Posn
    _) = String
    "#line "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    rString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ShowS
    forall a. Show a => a -> String
    show String
    f

    -- | haskell-style printing of file position
    haskline :: Posn -> String
    haskline :: Posn -> String
    haskline (Pn String
    f Int
    r Int
    _ Maybe Posn
    _) = String
    "{-# LINE "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    rString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ShowS
    forall a. Show a => a -> String
    show String
    fString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " #-}"

    -- | Conversion from a cpp-style "#line" to haskell-style pragma.
    cpp2hask :: String -> String
    cpp2hask :: ShowS
    cpp2hask String
    line | String
    "#line" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    line = String
    "{-# LINE "
                                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[String] -> String
    unwords ([String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    tail (String -> [String]
    words String
    line))
                                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " #-}"
                  | Bool
    otherwise = String
    line

    -- | Strip non-directory suffix from file name (analogous to the shell
    --   command of the same name).
    dirname :: String -> String
    dirname :: ShowS
    dirname  = ShowS
    forall a. [a] -> [a]
    reverse ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. [a] -> [a]
    safetail ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`String
    "\\/")) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. [a] -> [a]
    reverse
      where safetail :: [a] -> [a]
    safetail [] = []
            safetail (a
    _:[a]
    x) = [a]
    x

    -- | Sigh.  Mixing Windows filepaths with unix is bad.  Make sure there is a
    --   canonical path separator.
    cleanPath :: FilePath -> FilePath
    cleanPath :: ShowS
    cleanPath [] = []
    cleanPath (Char
    '\\':String
    cs) = Char
    '/'Char -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    cleanPath String
    cs
    cleanPath (Char
    c:String
    cs)    = Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :   ShowS
    cleanPath String
    cs