Migrate to `Felix` namespaceHEADhotg

1 files changed, 0 insertions, 250 deletions

diff --git a/source/Syntax/Pragma.hs b/source/Syntax/Pragma.hs
deleted file mode 100644
index 94c0d46..0000000
--- a/source/Syntax/Pragma.hs
+++ /dev/null
@@ -1,250 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Syntax.Pragma
-    ( SourceMixfixLevel
-    , sourceMixfixLevelValue
-    , SyntaxPragma(..)
-    , SyntaxPragmaProblem(..)
-    , SyntaxPragmaError(..)
-    , renderSyntaxPragmaError
-    , extractSyntaxPragmas
-    ) where
-
-import Base
-
-import Report.Location
-import Syntax.Abstract (Associativity(..))
-
-import Control.DeepSeq (NFData)
-import Control.Monad (unless, when)
-import Data.Bifunctor (first)
-import Data.Char (ord)
-import Data.Text qualified as Text
-import Data.Word (Word8)
-
-
-newtype SourceMixfixLevel = SourceMixfixLevel Word8
-    deriving stock (Show, Eq, Ord, Generic)
-    deriving anyclass (NFData)
-
-sourceMixfixLevelValue :: SourceMixfixLevel -> Word8
-sourceMixfixLevelValue (SourceMixfixLevel level) =
-    level
-
-data SyntaxPragma = LocatedFixityPragma
-    { syntaxPragmaLocation :: !Location
-    , syntaxPragmaAssociativity :: !Associativity
-    , syntaxPragmaLevel :: !SourceMixfixLevel
-    } deriving stock (Show, Eq)
-
-instance Locatable SyntaxPragma where
-    locate = syntaxPragmaLocation
-
-data SyntaxPragmaProblem
-    = SyntaxPragmaMissingSpaceAfterPrefix
-    | SyntaxPragmaMissingKeyword
-    | SyntaxPragmaUnknownKeyword !Text
-    | SyntaxPragmaMissingLevel
-    | SyntaxPragmaInvalidLevel
-    | SyntaxPragmaLevelOutOfRange
-    | SyntaxPragmaTrailingContent
-    | SyntaxPragmaLoneCarriageReturn
-    deriving stock (Show, Eq)
-
-data SyntaxPragmaError
-    = InvalidSyntaxPragma !Location !SyntaxPragmaProblem
-    | SyntaxPragmaLocationOutOfRange !FilePath !Int !Int
-    deriving stock (Show, Eq)
-
-renderSyntaxPragmaError :: SyntaxPragmaError -> Text
-renderSyntaxPragmaError = \case
-    InvalidSyntaxPragma location problem ->
-        locationToText location
-            <> ": "
-            <> renderSyntaxPragmaProblem problem
-    SyntaxPragmaLocationOutOfRange file line column ->
-        Text.pack file
-            <> ": syntax pragma location is out of range at "
-            <> Text.pack (show line)
-            <> ":"
-            <> Text.pack (show column)
-
-renderSyntaxPragmaProblem :: SyntaxPragmaProblem -> Text
-renderSyntaxPragmaProblem = \case
-    SyntaxPragmaMissingSpaceAfterPrefix ->
-        "expected horizontal space after %!"
-    SyntaxPragmaMissingKeyword ->
-        "missing syntax pragma keyword"
-    SyntaxPragmaUnknownKeyword keyword ->
-        "unknown syntax pragma keyword " <> Text.pack (show keyword)
-    SyntaxPragmaMissingLevel ->
-        "missing syntax pragma level"
-    SyntaxPragmaInvalidLevel ->
-        "syntax pragma level must use ASCII decimal digits"
-    SyntaxPragmaLevelOutOfRange ->
-        "syntax pragma level must be between 0 and 7"
-    SyntaxPragmaTrailingContent ->
-        "unexpected trailing syntax pragma content"
-    SyntaxPragmaLoneCarriageReturn ->
-        "a syntax pragma line must end with LF, CRLF, or end of file"
-
-extractSyntaxPragmas
-    :: FileId
-    -> FilePath
-    -> Text
-    -> Either SyntaxPragmaError [SyntaxPragma]
-extractSyntaxPragmas fileId file =
-    go 1
-  where
-    go lineNumber source
-        | Text.null source =
-            Right []
-        | otherwise = do
-            let (rawLine, suffix) =
-                    Text.break (== '\n') source
-                hasLineFeed =
-                    not (Text.null suffix)
-                (line, lineEnding) =
-                    if hasLineFeed && Text.isSuffixOf "\r" rawLine
-                        then
-                            (Text.dropEnd 1 rawLine, CrLf)
-                        else if hasLineFeed
-                            then
-                                (rawLine, LineFeed)
-                            else
-                                (rawLine, EndOfFile)
-                remaining =
-                    if hasLineFeed
-                        then Text.drop 1 suffix
-                        else ""
-                reserved =
-                    Text.isPrefixOf "%!"
-                        (Text.dropWhile isHorizontalSpace line)
-            pragma <-
-                if reserved
-                    then Just <$> parsePragmaLine
-                        fileId
-                        file
-                        lineNumber
-                        lineEnding
-                        line
-                    else
-                        Right Nothing
-            rest <- go (lineNumber + 1) remaining
-            pure (maybe rest (: rest) pragma)
-
-data LineEnding
-    = LineFeed
-    | CrLf
-    | EndOfFile
-    deriving stock (Show, Eq)
-
-parsePragmaLine
-    :: FileId
-    -> FilePath
-    -> Int
-    -> LineEnding
-    -> Text
-    -> Either SyntaxPragmaError SyntaxPragma
-parsePragmaLine fileId file lineNumber lineEnding rawLine = do
-    let horizontalPrefix =
-            Text.takeWhile isHorizontalSpace rawLine
-        column =
-            Text.length horizontalPrefix + 1
-    location <-
-        first
-            (const
-                (SyntaxPragmaLocationOutOfRange
-                    file
-                    lineNumber
-                    column))
-            (mkLocationChecked fileId lineNumber column)
-    let invalid
-            :: SyntaxPragmaProblem
-            -> Either SyntaxPragmaError a
-        invalid =
-            Left . InvalidSyntaxPragma location
-        afterPrefix =
-            Text.drop 2
-                (Text.dropWhile isHorizontalSpace rawLine)
-    when
-        (lineEnding == EndOfFile
-            && Text.isSuffixOf "\r" rawLine)
-        (invalid SyntaxPragmaLoneCarriageReturn)
-    afterPrefixSpace <-
-        case Text.uncons afterPrefix of
-            Nothing ->
-                invalid SyntaxPragmaMissingKeyword
-            Just (char, _)
-                | not (isHorizontalSpace char) ->
-                    invalid SyntaxPragmaMissingSpaceAfterPrefix
-            Just{} ->
-                Right (Text.dropWhile isHorizontalSpace afterPrefix)
-    when
-        (Text.null afterPrefixSpace)
-        (invalid SyntaxPragmaMissingKeyword)
-    let (keyword, afterKeyword) =
-            Text.break isHorizontalSpace afterPrefixSpace
-    associativity <-
-        case keyword of
-            "infixl" ->
-                Right LeftAssoc
-            "infixr" ->
-                Right RightAssoc
-            "infix" ->
-                Right NonAssoc
-            _ ->
-                invalid (SyntaxPragmaUnknownKeyword keyword)
-    afterKeywordSpace <-
-        case Text.uncons afterKeyword of
-            Nothing ->
-                invalid SyntaxPragmaMissingLevel
-            Just{} ->
-                Right (Text.dropWhile isHorizontalSpace afterKeyword)
-    when
-        (Text.null afterKeywordSpace)
-        (invalid SyntaxPragmaMissingLevel)
-    let (digits, trailing) =
-            Text.span isAsciiDigit afterKeywordSpace
-    when
-        (Text.null digits)
-        (invalid SyntaxPragmaInvalidLevel)
-    level <-
-        maybe
-            (invalid SyntaxPragmaLevelOutOfRange)
-            (Right . SourceMixfixLevel)
-            (sourceLevel digits)
-    unless
-        (Text.null (Text.dropWhile isHorizontalSpace trailing))
-        (invalid SyntaxPragmaTrailingContent)
-    pure
-        LocatedFixityPragma
-            { syntaxPragmaLocation = location
-            , syntaxPragmaAssociativity = associativity
-            , syntaxPragmaLevel = level
-            }
-
-isHorizontalSpace :: Char -> Bool
-isHorizontalSpace char =
-    char == ' ' || char == '\t'
-
-isAsciiDigit :: Char -> Bool
-isAsciiDigit char =
-    '0' <= char && char <= '9'
-
-sourceLevel :: Text -> Maybe Word8
-sourceLevel =
-    Text.foldl' step (Just 0)
-  where
-    step Nothing _ =
-        Nothing
-    step (Just current) char =
-        let next =
-                current * 10
-                    + fromIntegral (ord char - ord '0')
-        in
-            if next <= 7
-                then Just next
-                else Nothing