LocationInfo.hs

-- | Trace messages with location information
--
-- This module should only be used within the @HsBindgen.IR@ hierarchy.  From
-- outside the @HsBindgen.IR@ hierarchy, "HsBindgen.IR.C" should be used.
--
-- Within @HsBindgen.IR@, all modules aside from "HsBindgen.IR.C" should import
-- this module qualified for consistency.
--
-- > import HsBindgen.IR.C.LocationInfo qualified as C
module HsBindgen.IR.C.LocationInfo (
    WithLocationInfo(..)
    -- * Location info
  , LocationInfo(..)
    -- ** Construction
  , prelimDeclIdLocationInfo
  , declIdLocationInfo
    -- ** Query
  , locationInfoName
  , locationInfoLocs
    -- * Declaration locations
  , DeclLocs(..)
  , declLocsMin
  , declLocsToList
  ) where

import Data.List.NonEmpty qualified as NonEmpty
import Text.SimplePrettyPrint (CtxDoc, (><))
import Text.SimplePrettyPrint qualified as PP

import Clang.HighLevel.Types

import HsBindgen.IR.C.Conflict qualified as C
import HsBindgen.IR.C.DeclPath qualified as C
import HsBindgen.IR.C.Naming qualified as C
import HsBindgen.Util.Tracer

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Trace message with location information
data WithLocationInfo a = WithLocationInfo{
      loc :: LocationInfo
    , msg :: a
    }
  deriving stock (Eq, Ord, Show, Functor)

instance IsTrace lvl a => IsTrace lvl (WithLocationInfo a) where
  getDefaultLogLevel x = getDefaultLogLevel x.msg
  getSource          x = getSource          x.msg
  getTraceId         x = getTraceId         x.msg

instance PrettyForTrace a => PrettyForTrace (WithLocationInfo a) where
  prettyForTrace x =
      case x.loc of
        LocationUnavailable ->
          prettyForTrace x.msg
        _otherwise ->
          PP.hang (prettyForTrace x.loc >< ":") 2 $
            prettyForTrace x.msg

{-------------------------------------------------------------------------------
  Location info
-------------------------------------------------------------------------------}

data LocationInfo =
    -- | Message about a named declaration in the C source
    --
    -- Usually we expect the list of locations to be a singleton: the location
    -- of the declaration.
    LocationDeclNamed C.DeclName [SingleLoc C.DeclPath]

    -- | Message about an unnamed declaration
    --
    -- We record the /assigned/ name, /if/ it is available.
    --
    -- Usually we expect the list of locations to be a singleton: the location
    -- of the declaration.
  | LocationDeclUnnamed (Maybe C.DeclName) [SingleLoc C.DeclPath]

    -- | No location information
  | LocationUnavailable
  deriving stock (Eq, Ord, Show)

instance PrettyForTrace LocationInfo where
  prettyForTrace = \case
      LocationDeclNamed name locs -> PP.hsep [
          prettyForTrace name
        , "at"
        , prettyLocs locs
        ]
      LocationDeclUnnamed (Just name) locs -> PP.hsep [
          "unnamed declaration"
        , prettyForTrace name
        , "at"
        , prettyLocs locs
        ]
      LocationDeclUnnamed Nothing locs -> PP.hsep [
          "unnamed declaration at"
        , prettyLocs locs
        ]
      LocationUnavailable ->
        "location unavailable"
    where
      prettyLocs :: Show a => [a] -> CtxDoc
      prettyLocs = \case
        []    -> "(source location unavailable)"
        [loc] -> PP.show loc
        locs  -> PP.hlist "(" ")" (map PP.show locs)

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

prelimDeclIdLocationInfo :: C.PrelimDeclId -> [SingleLoc C.DeclPath] -> LocationInfo
prelimDeclIdLocationInfo prelimDeclId knownLocs =
    case prelimDeclId of
      C.PrelimDeclIdNamed name        -> LocationDeclNamed name knownLocs
      C.PrelimDeclIdUnnamed unnamedId -> LocationDeclUnnamed Nothing [C.InHeader <$> unnamedId.loc]

declIdLocationInfo :: C.DeclId -> [SingleLoc C.DeclPath] -> LocationInfo
declIdLocationInfo declId knownLocs =
    if not declId.isUnnamed
      then LocationDeclNamed declId.name knownLocs
      else LocationDeclUnnamed (Just declId.name) knownLocs

{-------------------------------------------------------------------------------
  Query
-------------------------------------------------------------------------------}

locationInfoName :: LocationInfo -> Maybe C.DeclName
locationInfoName = \case
    LocationDeclNamed name _    -> Just name
    LocationDeclUnnamed mName _ -> mName
    LocationUnavailable         -> Nothing

locationInfoLocs :: LocationInfo -> [SingleLoc C.DeclPath]
locationInfoLocs = \case
    LocationDeclNamed _ locs   -> locs
    LocationDeclUnnamed _ locs -> locs
    LocationUnavailable        -> []

{-------------------------------------------------------------------------------
  Declaration locations
-------------------------------------------------------------------------------}

-- | Source location(s) of a declaration.
--
-- Most declarations have a single source location; only conflicting
-- declarations carry more than one.
data DeclLocs =
    -- | The declaration has a single source location.
    DeclLoc (SingleLoc C.DeclPath)
    -- | Conflicting declarations, each with its own source location.
  | DeclLocsConflict C.Conflict
  deriving stock (Eq, Ord, Show)

-- | Attempts to get the “minimum” location.
--
-- This is only meaningful if the locations share the same source path.
-- Comparisons across source paths happen in lexicographical order.
declLocsMin :: DeclLocs -> SingleLoc C.DeclPath
declLocsMin = \case
  DeclLoc x                 -> x
  DeclLocsConflict conflict -> C.conflictGetMinimumLoc conflict

-- | All source locations, discarding the single vs conflict distinction.
declLocsToList :: DeclLocs -> [SingleLoc C.DeclPath]
declLocsToList = \case
    DeclLoc          loc      -> [loc]
    DeclLocsConflict conflict -> NonEmpty.toList $ C.conflictToList conflict