{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards   #-}
-- | Showing references to slices of code
module Language.Haskell.Homplexity.SrcSlice (
    SrcSlice
  , srcSlice
  , srcLoc
  , showSrcSpan
  , mergeSrcLocs
  , sliceFirstLine
  , sliceLastLine
  , sliceFilename
  , locAsSpan
  ) where

import Data.Data
import Data.Generics.Uniplate.Data
import Control.Arrow
import Control.Exception (assert)
import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.SrcLoc

-- * Slice of code
type SrcSlice  = SrcSpan

sliceFilename :: SrcSpan -> String
sliceFilename :: SrcSpan -> String
sliceFilename  = SrcSpan -> String
srcSpanFilename

sliceFirstLine :: SrcSpan -> Int
sliceFirstLine :: SrcSpan -> Int
sliceFirstLine = SrcSpan -> Int
srcSpanStartLine

sliceLastLine :: SrcSpan -> Int
sliceLastLine :: SrcSpan -> Int
sliceLastLine  = SrcSpan -> Int
srcSpanEndLine

srcLoc :: (Data code, Show code) => code -> SrcLoc
srcLoc :: forall code. (Data code, Show code) => code -> SrcLoc
srcLoc code
code = [SrcLoc] -> SrcLoc
forall {a}. [a] -> a
checkHead  ([SrcLoc] -> SrcLoc) -> [SrcLoc] -> SrcLoc
forall a b. (a -> b) -> a -> b
$
              code -> [SrcLoc]
forall from to. Biplate from to => from -> [to]
universeBi   code
code
  where
    msg :: String
msg             = String
"Cannot find SrcLoc in the code fragment: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ code -> String
forall a. Show a => a -> String
show code
code
    checkHead :: [a] -> a
checkHead []    = String -> a
forall a. HasCallStack => String -> a
error String
msg
    checkHead (a
e:[a]
_) = a
e

-- | Compute the slice of code that given source fragment is in (for naming)
srcSlice     :: (Data a, Show a)
             => a -> SrcSpan
srcSlice :: forall a. (Data a, Show a) => a -> SrcSpan
srcSlice a
code = [SrcLoc] -> SrcSpan
mergeSrcLocs
              ([SrcLoc] -> SrcSpan) -> (a -> [SrcLoc]) -> a -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcLoc] -> [SrcLoc]
forall {a}. [a] -> [a]
checkNonEmpty
              ([SrcLoc] -> [SrcLoc]) -> (a -> [SrcLoc]) -> a -> [SrcLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [SrcLoc]
forall from to. Biplate from to => from -> [to]
universeBi    (a -> SrcSpan) -> a -> SrcSpan
forall a b. (a -> b) -> a -> b
$ a
code
  where
    checkNonEmpty :: [a] -> [a]
checkNonEmpty []    = String -> [a]
forall a. HasCallStack => String -> a
error (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$ String
"Can't know how make a SrcSlice from code fragment: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
code
    checkNonEmpty [a]
other = [a]
other

mergeSrcLocs :: [SrcLoc] -> SrcSpan
mergeSrcLocs :: [SrcLoc] -> SrcSpan
mergeSrcLocs []        = String -> SrcSpan
forall a. HasCallStack => String -> a
error String
"Don't know how make a SrcSpan from an empty list of locations!"
mergeSrcLocs [SrcLoc]
sliceLocs = [String] -> Bool
forall a. Eq a => [a] -> Bool
allEqual ((SrcLoc -> String) -> [SrcLoc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SrcLoc -> String
srcFilename [SrcLoc]
sliceLocs) Bool -> SrcSpan -> SrcSpan
forall a. HasCallStack => Bool -> a -> a
`assert`
                           SrcSpan {Int
String
srcSpanFilename :: String
srcSpanStartLine :: Int
srcSpanEndLine :: Int
srcSpanFilename :: String
srcSpanStartLine :: Int
srcSpanStartColumn :: Int
srcSpanEndLine :: Int
srcSpanEndColumn :: Int
srcSpanEndColumn :: Int
srcSpanStartColumn :: Int
..}
  where
    srcSpanFilename :: String
srcSpanFilename = SrcLoc -> String
srcFilename (SrcLoc -> String) -> SrcLoc -> String
forall a b. (a -> b) -> a -> b
$ [SrcLoc] -> SrcLoc
forall a. HasCallStack => [a] -> a
head [SrcLoc]
sliceLocs
    ((Int
srcSpanStartLine, Int
srcSpanStartColumn),
     (Int
srcSpanEndLine,   Int
srcSpanEndColumn  )) = ([(Int, Int)] -> (Int, Int)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([(Int, Int)] -> (Int, Int))
-> ([(Int, Int)] -> (Int, Int))
-> [(Int, Int)]
-> ((Int, Int), (Int, Int))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [(Int, Int)] -> (Int, Int)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum) ([(Int, Int)] -> ((Int, Int), (Int, Int)))
-> [(Int, Int)] -> ((Int, Int), (Int, Int))
forall a b. (a -> b) -> a -> b
$
                                               (SrcLoc -> (Int, Int)) -> [SrcLoc] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (SrcLoc -> Int
srcLine (SrcLoc -> Int) -> (SrcLoc -> Int) -> SrcLoc -> (Int, Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SrcLoc -> Int
srcColumn) [SrcLoc]
sliceLocs

locAsSpan            :: SrcLoc -> SrcSpan
locAsSpan :: SrcLoc -> SrcSpan
locAsSpan SrcLoc {Int
String
srcFilename :: SrcLoc -> String
srcLine :: SrcLoc -> Int
srcColumn :: SrcLoc -> Int
srcFilename :: String
srcLine :: Int
srcColumn :: Int
..} = SrcSpan { srcSpanStartLine :: Int
srcSpanStartLine   = Int
srcLine
                                , srcSpanEndLine :: Int
srcSpanEndLine     = Int
srcLine
                                , srcSpanStartColumn :: Int
srcSpanStartColumn = Int
srcColumn
                                , srcSpanEndColumn :: Int
srcSpanEndColumn   = Int
srcColumn
                                , srcSpanFilename :: String
srcSpanFilename    = String
srcFilename
                                }

allEqual       ::  Eq a => [a] -> Bool
allEqual :: forall a. Eq a => [a] -> Bool
allEqual []     = Bool
True
allEqual (a
b:[a]
bs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a
ba -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
bs

showSrcSpan             :: SrcSpan -> ShowS
showSrcSpan :: SrcSpan -> String -> String
showSrcSpan SrcSpan {Int
String
srcSpanFilename :: SrcSpan -> String
srcSpanStartLine :: SrcSpan -> Int
srcSpanEndLine :: SrcSpan -> Int
srcSpanEndColumn :: SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanFilename :: String
srcSpanStartLine :: Int
srcSpanStartColumn :: Int
srcSpanEndLine :: Int
srcSpanEndColumn :: Int
..} = String -> String -> String
forall a. Show a => a -> String -> String
shows String
srcSpanFilename
                         (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:)
                         (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Show a => a -> String -> String
shows Int
srcSpanStartLine
                         (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:)
                         (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Show a => a -> String -> String
shows Int
srcSpanEndLine