content: {-# 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  = srcSpanFilename
  
  sliceFirstLine :: SrcSpan -> Int
  sliceFirstLine = srcSpanStartLine
  
  sliceLastLine :: SrcSpan -> Int
  sliceLastLine  = srcSpanEndLine
  
  srcLoc :: (Data code, Show code) => code -> SrcLoc
  srcLoc code = checkHead  $
                universeBi   code
    where
      msg             = "Cannot find SrcLoc in the code fragment: " ++ show code
      checkHead []    = error msg
      checkHead (e:_) = e
  
  -- | Compute the slice of code that given source fragment is in (for naming)
  srcSlice     :: (Data a, Show a)
               => a -> SrcSpan
  srcSlice code = mergeSrcLocs
                . checkNonEmpty
                . universeBi    $ code
    where
      checkNonEmpty []    = error $ "Can't know how make a SrcSlice from code fragment: " ++ show code
      checkNonEmpty other = other
  
  mergeSrcLocs :: [SrcLoc] -> SrcSpan
  mergeSrcLocs []        = error "Don't know how make a SrcSpan from an empty list of locations!"
  mergeSrcLocs sliceLocs = allEqual (map srcFilename sliceLocs) `assert`
                             SrcSpan {..}
    where
      srcSpanFilename = srcFilename $ head sliceLocs
      ((srcSpanStartLine, srcSpanStartColumn),
       (srcSpanEndLine,   srcSpanEndColumn  )) = (minimum &&& maximum) $
                                                 map (srcLine &&& srcColumn) sliceLocs
  
  locAsSpan            :: SrcLoc -> SrcSpan
  locAsSpan SrcLoc {..} = SrcSpan { srcSpanStartLine   = srcLine
                                  , srcSpanEndLine     = srcLine
                                  , srcSpanStartColumn = srcColumn
                                  , srcSpanEndColumn   = srcColumn
                                  , srcSpanFilename    = srcFilename
                                  }
  
  allEqual       ::  Eq a => [a] -> Bool
  allEqual []     = True
  allEqual (b:bs) = all (b==) bs
  
  showSrcSpan             :: SrcSpan -> ShowS
  showSrcSpan SrcSpan {..} = shows srcSpanFilename
                           . (':':)
                           . shows srcSpanStartLine
                           . ('-':)
                           . shows srcSpanEndLine
  
  