fluent-lint-1.0.0: app/Document.hs

module Document where

import Data.Functor ((<&>))
import Data.List ((!?))
import Data.List qualified as List
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Effectful
import Language.Fluent.AST
import Language.Fluent.Parser (parseResourceLenient)
import System.IO (IOMode (ReadMode), hSetEncoding, utf8, withFile)
import Prelude

-- | A Fluent file, with its text and what was parsed from it.
data Document = Document
    { path :: FilePath
    , source :: Text
    , messages :: Map Text (Set Text)
    , errors :: [ParseError]
    }

-- | Reads and parses a file, which is UTF-8 whatever the locale is.
read :: (IOE :> es) => FilePath -> Eff es Document
read path = do
    source <- liftIO . withFile path ReadMode $ \handle ->
        hSetEncoding handle utf8 *> Text.hGetContents handle
    let resource = parseResourceLenient source
    pure
        Document
            { messages =
                Map.fromList
                    [ (name, Set.fromList [name | Attribute (Identifier name) _ <- attributes])
                    | MessageEntry Message{id = Identifier name, attributes} <- resource.entries
                    ]
            , errors = [e | JunkEntry _ e <- resource.entries]
            , ..
            }

-- | Renders syntax errors, each with its source line and an arrow under the column.
renderErrors :: Document -> String
renderErrors Document{source = Text.lines -> source, ..} =
    List.intercalate "\n\n" $
        errors <&> \ParseError{..} ->
            let number = show line
                shown =
                    Text.unpack
                        . Text.dropWhileEnd (== '\r')
                        . fromMaybe Text.empty
                        $ source !? (line - 1)
             in List.intercalate
                    "\n"
                    [ path <> ":" <> number <> ":" <> show column <> ": " <> reason
                    , number <> " | " <> shown
                    , blank number <> " | " <> blank (take (column - 1) shown) <> "^"
                    ]
  where
    blank :: String -> String
    blank = fmap \c -> if c == '\t' then c else ' '