diff --git a/.github/workflows/ghc.yml b/.github/workflows/ghc.yml index 42eee0293..9b8b86911 100644 --- a/.github/workflows/ghc.yml +++ b/.github/workflows/ghc.yml @@ -55,7 +55,6 @@ jobs: pattern: | eo-phi-normalizer/**/*.hs !${{ env.syntax-dir }}/**/*.hs - !eo-phi-normalizer/Setup.hs - uses: haskell-actions/hlint-setup@v2 @@ -105,10 +104,6 @@ jobs: submodules: true ref: ${{ github.ref }} - - name: Set codepage on Windows - if: ${{ runner.os == 'Windows' }} - run: chcp 65001 - - name: Restore Syntax files id: restore-syntax-files uses: actions/cache/restore@v4 @@ -163,10 +158,6 @@ jobs: submodules: true ref: ${{ github.ref }} - - name: Set codepage on Windows - if: ${{ runner.os == 'Windows' }} - run: chcp 65001 - - name: Restore Syntax files id: restore-syntax-files uses: actions/cache/restore@v4 diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 11ed4b22a..40dc8acd6 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -25,5 +25,4 @@ repos: exclude: | (?x)^( eo-phi-normalizer/src/Language/EO/Phi/Syntax/| - eo-phi-normalizer/Setup.hs - ) \ No newline at end of file + ) diff --git a/eo-phi-normalizer/Setup.hs b/eo-phi-normalizer/Setup.hs index f3577e176..127cffe93 100644 --- a/eo-phi-normalizer/Setup.hs +++ b/eo-phi-normalizer/Setup.hs @@ -21,7 +21,9 @@ -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -- SOFTWARE. {- FOURMOLU_ENABLE -} -{-# LANGUAGE CPP #-} + +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -- Source: https://github.com/haskell/cabal/issues/6726#issuecomment-918663262 @@ -30,65 +32,76 @@ -- for the parsers included in Ogma. module Main (main) where +import Control.Exception (SomeException, catch, displayException, evaluate) +import Data.ByteString as BS (readFile, writeFile) import Data.List (intercalate) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Distribution.Simple (defaultMainWithHooks, hookedPrograms, postConf, preBuild, simpleUserHooks) import Distribution.Simple.Program (Program (..), findProgramVersion, simpleProgram) +import Main.Utf8 (withUtf8) import PyF (fmt) -import System.Exit (ExitCode (..)) +import System.Exit (ExitCode (..), exitWith) +import System.IO.CodePage (withCP65001) import System.Process (callCommand) -import Text.Printf (printf) -import Control.Exception (evaluate) + +readFile' :: FilePath -> IO Text +readFile' = (decodeUtf8 <$>) . BS.readFile + +writeFile' :: FilePath -> Text -> IO () +writeFile' path = BS.writeFile path . encodeUtf8 + +withCorrectLocale :: IO a -> IO a +withCorrectLocale act = do + let withCorrectLocale' = withCP65001 . Main.Utf8.withUtf8 + withCorrectLocale' act + `catch` ( \(x :: SomeException) -> + withCorrectLocale' do + putStrLn (displayException x) + exitWith (ExitFailure 1) + ) -- | Run BNFC, happy, and alex on the grammar before the actual build step. -- -- All options for bnfc are hard-coded here. main :: IO () main = - defaultMainWithHooks $ - simpleUserHooks - { hookedPrograms = [bnfcProgram] - , postConf = \args flags packageDesc localBuildInfo -> do - let - isWindows = -#ifdef mingw32_HOST_OS - True -#else - False -#endif - -- See the details on the command form in https://github.com/objectionary/eo-phi-normalizer/issues/347#issuecomment-2117097070 - addLicense :: FilePath -> IO () - addLicense file = do - let readFile' path = do - content <- readFile path - evaluate (length content) - pure content - targetFile = "src/Language/EO/Phi/Syntax/" <> file - license <- readFile' "LICENSE" - let licenseFormatted = printf "{-\n%s-}\n\n" license - code <- readFile' targetFile - evaluate (length license) - writeFile targetFile (licenseFormatted <> code) - - command = intercalate "; " $ - [ "set -ex" ] <> - [ "chcp.com" | isWindows ] <> - [ "chcp.com 65001" | isWindows ] <> - [ "bnfc --haskell -d -p Language.EO.Phi --generic -o src/ grammar/EO/Phi/Syntax.cf"] <> - [ "cd src/Language/EO/Phi/Syntax" ] <> - [ "alex Lex.x" ] <> - [ "happy Par.y" ] <> - [ "true" ] - - fullCommand = [fmt|bash -c ' {command} '|] - - putStrLn fullCommand - - _ <- callCommand fullCommand - _ <- addLicense "Abs.hs" - _ <- addLicense "Print.hs" - - postConf simpleUserHooks args flags packageDesc localBuildInfo - } + withCorrectLocale $ + defaultMainWithHooks $ + simpleUserHooks + { hookedPrograms = [bnfcProgram] + , postConf = \args flags packageDesc localBuildInfo -> do + let + addLicense :: FilePath -> IO () + addLicense file = do + let targetFile = "src/Language/EO/Phi/Syntax/" <> file + license <- readFile' "LICENSE" + let licenseFormatted = [fmt|{{-\n{license}-}}\n\n|] :: Text + code <- readFile' targetFile + writeFile' targetFile (licenseFormatted <> code) + + -- See the details on the command form in https://github.com/objectionary/eo-phi-normalizer/issues/347#issuecomment-2117097070 + command = + intercalate + "; " + [ "set -ex" + , "bnfc --haskell -d -p Language.EO.Phi --generic -o src/ grammar/EO/Phi/Syntax.cf" + , "cd src/Language/EO/Phi/Syntax" + , "alex Lex.x" + , "happy Par.y" + , "true" + ] + + fullCommand = [fmt|bash -c ' {command} '|] + + putStrLn fullCommand + + _ <- callCommand fullCommand + _ <- addLicense "Abs.hs" + _ <- addLicense "Print.hs" + + postConf simpleUserHooks args flags packageDesc localBuildInfo + } -- | NOTE: This should be in Cabal.Distribution.Simple.Program.Builtin. bnfcProgram :: Program diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs index aaeadce8e..e575c33ac 100644 --- a/eo-phi-normalizer/app/Main.hs +++ b/eo-phi-normalizer/app/Main.hs @@ -51,7 +51,7 @@ module Main (main) where -import Control.Exception (Exception (..), SomeException, catch, throw) +import Control.Exception (Exception (..), SomeException, catch, throwIO) import Control.Lens.Lens ((&)) import Control.Lens.Operators ((?~)) import Control.Monad (forM, unless, when) @@ -67,6 +67,7 @@ import Data.Text.Lazy.Manipulate (toOrdinal) import Data.Version (showVersion) import Data.Yaml (decodeFileThrow, decodeThrow) import GHC.Generics (Generic) +import Language.EO.Locale (withCorrectLocale) import Language.EO.Phi (Binding (..), Bytes (Bytes), Object (..), Program (Program), parseProgram, printTree) import Language.EO.Phi.Dataize import Language.EO.Phi.Dataize.Context @@ -84,7 +85,6 @@ import Language.EO.Phi.Rules.RunYegor (yegorRuleSet) import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRuleNamed, parseRuleSetFromFile) import Language.EO.Phi.ToLaTeX import Language.EO.Test.YamlSpec (spec) -import Main.Utf8 import Options.Applicative hiding (metavar) import Options.Applicative qualified as Optparse (metavar) import Paths_eo_phi_normalizer (version) @@ -470,14 +470,14 @@ getFile = \case Just file' -> doesFileExist file' >>= \case True -> pure (Just file') - False -> throw $ FileDoesNotExist file' + False -> throwIO $ FileDoesNotExist file' getProgram :: Maybe FilePath -> IO Program getProgram inputFile = do inputFile' <- getFile inputFile - src <- maybe getContents' readFile inputFile' `catch` (throw . CouldNotRead . show @SomeException) + src <- maybe getContents' readFile inputFile' `catch` (throwIO . CouldNotRead . show @SomeException) case parseProgram src of - Left err -> throw $ CouldNotParse err + Left err -> throwIO $ CouldNotParse err Right program -> pure program getLoggers :: Maybe FilePath -> IO (String -> IO (), String -> IO ()) @@ -514,7 +514,7 @@ getMetrics' program bindingsPath = do getMetrics :: Maybe String -> Maybe FilePath -> IO ProgramMetrics getMetrics bindingsPath inputFile = do program <- getProgram inputFile - either throw pure (getMetrics' program bindingsPath) + either throwIO pure (getMetrics' program bindingsPath) injectLamdbaPackage :: [Binding] -> [Binding] injectLamdbaPackage bs @@ -567,7 +567,7 @@ wrapRawBytesIn = \case -- * Main main :: IO () -main = withUtf8 do +main = withCorrectLocale do opts <- customExecParser pprefs (cliOpts (showVersion version)) let printAsProgramOrAsObject = \case Formation bindings' -> printTree $ Program bindings' @@ -600,7 +600,7 @@ main = withUtf8 do return (False, ruleSet.title, convertRuleNamed <$> ruleSet.rules) unless (single || json || latex) $ logStrLn ruleSetTitle bindingsWithDeps <- case deepMergePrograms (program' : deps) of - Left err -> throw (CouldNotMergeDependencies err) + Left err -> throwIO (CouldNotMergeDependencies err) Right (Program bindingsWithDeps) -> return bindingsWithDeps let Program bindings = program' uniqueResults @@ -629,7 +629,7 @@ main = withUtf8 do logStrLn "\\begin{phiquation*}" logStrLn [fmtTrim|{phiExpr}|] logStrLn "\\end{phiquation*}" - when (null uniqueResults || null (head uniqueResults)) (throw CouldNotNormalize) + when (null uniqueResults || null (head uniqueResults)) (throwIO CouldNotNormalize) if | single && json -> logStrLn @@ -690,7 +690,7 @@ main = withUtf8 do program' <- getProgram inputFile deps <- mapM (getProgram . Just) dependencies bindingsWithDeps <- case deepMergePrograms (program' : deps) of - Left err -> throw (CouldNotMergeDependencies err) + Left err -> throwIO (CouldNotMergeDependencies err) Right (Program bindingsWithDeps) -> return bindingsWithDeps (builtin, _ruleSetTitle, rules) <- case rulesPath of diff --git a/eo-phi-normalizer/eo-phi-normalizer.cabal b/eo-phi-normalizer/eo-phi-normalizer.cabal index e358bf15d..943255baf 100644 --- a/eo-phi-normalizer/eo-phi-normalizer.cabal +++ b/eo-phi-normalizer/eo-phi-normalizer.cabal @@ -202,10 +202,15 @@ custom-setup Cabal >=2.4.0.1 && <4.0 , PyF , base >=4.11.0.0 && <5.0 + , bytestring + , code-page , process >=1.6.3.0 + , text + , with-utf8 library exposed-modules: + Language.EO.Locale Language.EO.Phi Language.EO.Phi.Dataize Language.EO.Phi.Dataize.Atoms @@ -255,6 +260,7 @@ library , blaze-markup , bytestring , cereal + , code-page , containers , directory , file-embed >=0.0.16.0 @@ -271,6 +277,7 @@ library , text , text-manipulate , unordered-containers + , with-utf8 , yaml default-language: Haskell2010 @@ -298,6 +305,7 @@ executable eo-phi-normalizer , blaze-markup , bytestring , cereal + , code-page , containers , directory , eo-phi-normalizer @@ -324,6 +332,7 @@ test-suite doctests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: + Language.EO.Locale Language.EO.Phi Language.EO.Phi.Dataize Language.EO.Phi.Dataize.Atoms @@ -373,6 +382,7 @@ test-suite doctests , blaze-markup , bytestring , cereal + , code-page , containers , directory , doctest-parallel @@ -391,6 +401,7 @@ test-suite doctests , text , text-manipulate , unordered-containers + , with-utf8 , yaml default-language: Haskell2010 @@ -426,6 +437,7 @@ test-suite spec , blaze-markup , bytestring , cereal + , code-page , containers , directory , eo-phi-normalizer diff --git a/eo-phi-normalizer/package.yaml b/eo-phi-normalizer/package.yaml index 6debe96e0..10b1dee07 100644 --- a/eo-phi-normalizer/package.yaml +++ b/eo-phi-normalizer/package.yaml @@ -53,8 +53,12 @@ custom-setup: dependencies: - base >= 4.11.0.0 && < 5.0 - Cabal >= 2.4.0.1 && < 4.0 + - code-page - process >= 1.6.3.0 + - text - PyF + - bytestring + - with-utf8 build-tools: alex: ">= 3.2.4" @@ -87,6 +91,8 @@ dependencies: - hashable - unordered-containers - containers + - code-page + - with-utf8 default-extensions: - ImportQualifiedPost @@ -123,7 +129,6 @@ executables: - -rtsopts - -with-rtsopts=-N dependencies: - - with-utf8 - eo-phi-normalizer - optparse-applicative - aeson-pretty @@ -138,7 +143,6 @@ tests: - -with-rtsopts=-N dependencies: - eo-phi-normalizer - - with-utf8 - hspec - hspec-discover - QuickCheck diff --git a/eo-phi-normalizer/src/Language/EO/Locale.hs b/eo-phi-normalizer/src/Language/EO/Locale.hs new file mode 100644 index 000000000..f6e5717e2 --- /dev/null +++ b/eo-phi-normalizer/src/Language/EO/Locale.hs @@ -0,0 +1,42 @@ +{- FOURMOLU_DISABLE -} +-- The MIT License (MIT) + +-- Copyright (c) 2016-2024 Objectionary.com + +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: + +-- The above copyright notice and this permission notice shall be included +-- in all copies or substantial portions of the Software. + +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +{- FOURMOLU_ENABLE -} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Language.EO.Locale where + +import Control.Exception (Exception (..), SomeException, catch) +import Main.Utf8 (withUtf8) +import System.Exit (ExitCode (..), exitWith) +import System.IO.CodePage (withCP65001) + +withCorrectLocale :: IO a -> IO a +withCorrectLocale act = do + let withCorrectLocale' = withCP65001 . withUtf8 + withCorrectLocale' act + `catch` ( \(x :: SomeException) -> + withCorrectLocale' do + putStrLn (displayException x) + exitWith (ExitFailure 1) + ) diff --git a/eo-phi-normalizer/src/Language/EO/Phi.hs b/eo-phi-normalizer/src/Language/EO/Phi.hs index e055a36c2..055295d44 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi.hs @@ -36,13 +36,12 @@ import Language.EO.Phi.Syntax.Abs qualified as Phi import Language.EO.Phi.Syntax.Par qualified as Phi import Language.EO.Phi.Normalize +import Language.EO.Phi.Rules.Common (parseWith) import Language.EO.Phi.Syntax -- | Parse a 'Program' or return a parsing error. parseProgram :: String -> Either String Phi.Program -parseProgram input = Phi.pProgram tokens - where - tokens = Phi.myLexer input +parseProgram = parseWith Phi.pProgram -- | Parse an 'Object' or return a parsing error. parseObject :: String -> Either String Phi.Object diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs b/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs index c641134aa..221420517 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs @@ -27,6 +27,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -52,6 +53,7 @@ import Language.EO.Phi.Syntax.Abs import Language.EO.Phi.Syntax.Lex (Token) import Language.EO.Phi.Syntax.Par import Numeric (readHex, showHex) +import PyF (fmt) -- $setup -- >>> :set -XOverloadedStrings @@ -69,16 +71,17 @@ instance IsString ObjectHead where fromString = unsafeParseWith pObjectHead instance IsString MetaId where fromString = unsafeParseWith pMetaId parseWith :: ([Token] -> Either String a) -> String -> Either String a -parseWith parser input = parser tokens +parseWith parser input = either (\x -> Left [fmt|{x}\non the input:\n{input}|]) Right parsed where tokens = myLexer input + parsed = parser tokens -- | Parse a 'Object' from a 'String'. -- May throw an 'error` if input has a syntactical or lexical errors. unsafeParseWith :: ([Token] -> Either String a) -> String -> a unsafeParseWith parser input = case parseWith parser input of - Left parseError -> error (parseError <> "\non input\n" <> input <> "\n") + Left parseError -> error parseError Right object -> object -- | State of evaluation is not needed yet, but it might be in the future diff --git a/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs b/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs index c6f45d557..254304eb5 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/ToLaTeX.hs @@ -108,7 +108,7 @@ inMathMode = (" $ " <>) . (<> " $ ") instance ToLatex RuleContext where toLatex RuleContext{..} = maybe mempty (\x -> inMathMode $ toLatex GlobalObject <> " -> " <> toLatex x) global_object - <> maybe mempty (\x -> (inMathMode $ toLatex x) <> " is the scope of the redex") current_object + <> maybe mempty (\x -> inMathMode (toLatex x) <> " is the scope of the redex") current_object <> maybe mempty (\x -> toLatex x <> " is the current attribute") current_attribute instance ToLatex RuleAttribute where diff --git a/eo-phi-normalizer/test/Main.hs b/eo-phi-normalizer/test/Main.hs index cec86ad6b..ab33535a0 100644 --- a/eo-phi-normalizer/test/Main.hs +++ b/eo-phi-normalizer/test/Main.hs @@ -23,9 +23,9 @@ {- FOURMOLU_ENABLE -} module Main where -import Main.Utf8 +import Language.EO.Locale (withCorrectLocale) import Spec qualified import Test.Hspec.Runner main :: IO () -main = withUtf8 $ hspecWith defaultConfig Spec.spec +main = withCorrectLocale $ hspecWith defaultConfig Spec.spec