Merge remote-tracking branch 'origin' into 606-add-latex-to-docs

objectionary · Dec 4, 2024 · e553e83 · e553e83
2 parents e81c068 + ba58561
commit e553e83
Show file tree

Hide file tree

Showing 15 changed files with 184 additions and 104 deletions.
diff --git 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
@@ -25,5 +25,4 @@ repos:
         exclude: |
           (?x)^(
             eo-phi-normalizer/src/Language/EO/Phi/Syntax/|
-            eo-phi-normalizer/Setup.hs
-          )
+          )
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
@@ -14,13 +14,19 @@ Check open issues ([link](https://github.com/objectionary/eo-phi-normalizer/issu
 
 ## Enter the repository
 
+<!-- `> cat site/docs/src/common/enter-repository.md` -->
+
+<!-- BEGIN mdsh -->
+
 Clone and enter the project repository.
 
 ```sh
 git clone https://github.com/objectionary/eo-phi-normalizer --recurse-submodules
 cd eo-phi-normalizer
 ```
 
+<!-- END mdsh -->
+
 ## Install stack
 
 We recommend using [stack](https://docs.haskellstack.org/en/stable) for quick local development and testing.

diff --git 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,77 @@
 -- for the parsers included in Ogma.
 module Main (main) where
 
+import Control.Exception (Handler (..), SomeException, catches, 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 . withUtf8
+  withCorrectLocale' act
+    `catches` [ Handler $ \(x :: ExitCode) -> exitWith x
+              , Handler $ \(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
@@ -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
@@ -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
@@ -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