Migrate to `Felix` namespaceHEADhotg

1 files changed, 0 insertions, 284 deletions

diff --git a/source/Report/Location.hs b/source/Report/Location.hs
deleted file mode 100644
index 4495360..0000000
--- a/source/Report/Location.hs
+++ /dev/null
@@ -1,284 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
-
-module Report.Location where
-
-import Base
-import Text.Megaparsec.Pos (SourcePos (sourceColumn, sourceLine), unPos)
-import Data.Bits
-import Control.DeepSeq (NFData)
-import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
-import Data.IntMap.Strict qualified as IntMap
-import Data.Map.Strict qualified as Map
-import Data.Text qualified as Text
-import Data.Word (Word16, Word32)
-import System.IO.Unsafe (unsafePerformIO)
-
--- | File identifier used in packed source locations.
-newtype FileId = FileId
-    { unFileId :: Word16
-    } deriving stock (Show, Eq, Ord, Generic)
-      deriving anyclass (Hashable, NFData)
-
--- | Packed source location.
--- Bit layout (high to low):
--- 16 bits file id | 24 bits line | 24 bits column.
-newtype Location = Location
-    { unLocation :: Word64
-    } deriving stock (Eq, Ord, Generic)
-      deriving anyclass (Hashable, NFData)
-
-data RegisteredFile = RegisteredFile
-    { registeredFileIdentity :: FilePath
-    , registeredFileDisplayPath :: FilePath
-    }
-
-data FileRegistry = FileRegistry
-    { registrationToFileId :: Map (FilePath, FilePath) FileId
-    , fileIdToFile :: IntMap RegisteredFile
-    , fileIdAllocator :: !FileIdAllocator
-    }
-
-data LocationRegistrationError
-    = FileIdSpaceExhausted
-    deriving stock (Show, Eq)
-
-data LocationConstructionError
-    = LocationCoordinateOutOfRange !Int !Int
-    deriving stock (Show, Eq)
-
-newtype FileIdAllocator = FileIdAllocator Word32
-    deriving stock (Show, Eq)
-
-initialFileIdAllocator :: FileIdAllocator
-initialFileIdAllocator = FileIdAllocator 0
-
-allocateFileId
-    :: FileIdAllocator
-    -> Either LocationRegistrationError (FileId, FileIdAllocator)
-allocateFileId (FileIdAllocator next)
-    | next >= fromIntegral (maxBound :: Word16) =
-        Left FileIdSpaceExhausted
-    | otherwise =
-        Right
-            ( FileId (fromIntegral next)
-            , FileIdAllocator (next + 1)
-            )
-
-initialFileRegistry :: FileRegistry
-initialFileRegistry = FileRegistry
-    { registrationToFileId = mempty
-    , fileIdToFile = mempty
-    , fileIdAllocator = initialFileIdAllocator
-    }
-
-fileRegistryRef :: IORef FileRegistry
-fileRegistryRef = unsafePerformIO (newIORef initialFileRegistry)
-{-# NOINLINE fileRegistryRef #-}
-
-registerFilePath
-    :: MonadIO io
-    => FilePath
-    -> io (Either LocationRegistrationError FileId)
-registerFilePath path =
-    registerFilePathWithDisplay path path
-
--- | Register a file by physical identity while retaining a separate path for
--- diagnostics. The identity must be stable and unique for the selected
--- physical source. Distinct display paths receive distinct file identifiers so
--- one workspace cannot inherit another workspace's presentation. Callers with
--- only one path should use 'registerFilePath'.
-registerFilePathWithDisplay
-    :: MonadIO io
-    => FilePath
-    -> FilePath
-    -> io (Either LocationRegistrationError FileId)
-registerFilePathWithDisplay identity displayPath = liftIO $
-    atomicModifyIORef' fileRegistryRef \registry ->
-        case Map.lookup registration (registrationToFileId registry) of
-            Just fileId ->
-                (registry, Right fileId)
-            Nothing ->
-                case allocateFileId (fileIdAllocator registry) of
-                    Left err ->
-                        (registry, Left err)
-                    Right (fileId, nextAllocator) ->
-                        let fileIdInt = fromIntegral (unFileId fileId)
-                            registeredFile =
-                                RegisteredFile identity displayPath
-                            registry' = FileRegistry
-                                { registrationToFileId =
-                                    Map.insert
-                                        registration
-                                        fileId
-                                        (registrationToFileId registry)
-                                , fileIdToFile =
-                                    IntMap.insert
-                                        fileIdInt
-                                        registeredFile
-                                        (fileIdToFile registry)
-                                , fileIdAllocator = nextAllocator
-                                }
-                        in
-                            (registry', Right fileId)
-  where
-    registration = (identity, displayPath)
-
-lookupFilePath :: FileId -> Maybe FilePath
-lookupFilePath fileId = unsafePerformIO do
-    registry <- readIORef fileRegistryRef
-    pure
-        (registeredFileDisplayPath <$>
-            IntMap.lookup
-                (fromIntegral (unFileId fileId))
-                (fileIdToFile registry))
-
-lookupFileIdentityPath :: FileId -> Maybe FilePath
-lookupFileIdentityPath fileId = unsafePerformIO do
-    registry <- readIORef fileRegistryRef
-    pure
-        (registeredFileIdentity <$>
-            IntMap.lookup
-                (fromIntegral (unFileId fileId))
-                (fileIdToFile registry))
-
-fileShift, lineShift :: Int
-fileShift = 48
-lineShift = 24
-
-fileMask, coordMask :: Word64
-fileMask = 0xFFFF
-coordMask = 0xFFFFFF
-
-nowhereWord :: Word64
-nowhereWord = maxBound
-
-mkLocationChecked
-    :: FileId
-    -> Int
-    -> Int
-    -> Either LocationConstructionError Location
-mkLocationChecked fileId line column
-    | line < 0
-        || column < 0
-        || lineWord > coordMask
-        || columnWord > coordMask =
-            Left (LocationCoordinateOutOfRange line column)
-    | otherwise =
-        Right
-            (Location
-                (   (fromIntegral (unFileId fileId) `shiftL` fileShift)
-                 .|. (lineWord `shiftL` lineShift)
-                 .|. columnWord
-                ))
-    where
-        lineWord = fromIntegral line :: Word64
-        columnWord = fromIntegral column :: Word64
-
-mkLocation :: FileId -> Int -> Int -> Location
-mkLocation fileId line column =
-    either
-        (impossible . ("mkLocation: " <>) . show)
-        id
-        (mkLocationChecked fileId line column)
-
-locFileId :: Location -> Maybe FileId
-locFileId (Location w)
-    | w == nowhereWord = Nothing
-    | otherwise = Just (FileId (fromIntegral ((w `shiftR` fileShift) .&. fileMask)))
-
-locFile :: Location -> FilePath
-locFile loc = case locFileId loc of
-    Nothing -> "<nowhere>"
-    Just fileId ->
-        fromMaybe ("<file#" <> show (unFileId fileId) <> ">") (lookupFilePath fileId)
-
-locLine :: Location -> Int
-locLine (Location w)
-    | w == nowhereWord = -1
-    | otherwise = fromIntegral ((w `shiftR` lineShift) .&. coordMask)
-
-locColumn :: Location -> Int
-locColumn (Location w)
-    | w == nowhereWord = -1
-    | otherwise = fromIntegral (w .&. coordMask)
-
-instance Show Location where
-    showsPrec p loc =
-        showParen (p > appPrec) $
-            showString "Location {locFile = "
-            . shows (locFile loc)
-            . showString ", locLine = "
-            . shows (locLine loc)
-            . showString ", locColumn = "
-            . shows (locColumn loc)
-            . showString "}"
-      where
-        appPrec = 10
-
-fromSourcePosChecked
-    :: FileId
-    -> SourcePos
-    -> Either LocationConstructionError Location
-fromSourcePosChecked fileId pos =
-    mkLocationChecked
-        fileId
-        (unPos (sourceLine pos))
-        (unPos (sourceColumn pos))
-
-prettyLocation :: Location -> String
-prettyLocation loc =
-    locFile loc <> " " <> show (locLine loc) <> ":" <> show (locColumn loc)
-
--- | Render two locations together, qualifying equal display paths when they
--- refer to different physical files.
-prettyLocationPair :: Location -> Location -> (String, String)
-prettyLocationPair firstLocation secondLocation =
-    if locFile firstLocation == locFile secondLocation
-        && firstIdentity /= secondIdentity
-        && isJust firstIdentity
-        && isJust secondIdentity
-        then
-            ( qualify firstIdentity firstLocation
-            , qualify secondIdentity secondLocation
-            )
-        else
-            (prettyLocation firstLocation, prettyLocation secondLocation)
-  where
-    firstIdentity =
-        locFileId firstLocation >>= lookupFileIdentityPath
-    secondIdentity =
-        locFileId secondLocation >>= lookupFileIdentityPath
-
-    qualify identity location =
-        locFile location
-            <> " (canonical "
-            <> maybe "<unknown>" show identity
-            <> ") "
-            <> show (locLine location)
-            <> ":"
-            <> show (locColumn location)
-
-locationToText :: Location -> Text
-locationToText loc = Text.pack (prettyLocation loc)
-
--- | Things that have a location.
-class Locatable a where
-    locate :: a -> Location
-
-pattern Nowhere :: Location
-pattern Nowhere = Location 0xFFFFFFFFFFFFFFFF
-
-instance Locatable Location where
-    locate = id
-
-instance Locatable a => Locatable [a] where
-    locate []    = Nowhere
-    locate (x:_) = locate x
-
-instance Locatable a => Locatable (Maybe a) where
-    locate Nothing  = Nowhere
-    locate (Just x) = locate x
-
-instance Locatable a => Locatable (NonEmpty a) where
-    locate (x :| _) = locate x