phino-0.0.0.49: test/CLISpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT
module CLISpec (spec) where
import CLI (runCLI)
import Control.Exception
import Control.Monad (forM_, unless, when)
import Data.List (isInfixOf)
import Data.Version (showVersion)
import GHC.IO.Handle
import Paths_phino (version)
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, removeDirectoryRecursive, removeFile)
import System.Exit (ExitCode (ExitFailure))
import System.IO
import Test.Hspec
import Text.Printf (printf)
withStdin :: String -> IO a -> IO a
withStdin input action =
bracket (openTempFile "." "stdinXXXXXX.tmp") cleanup $ \(filePath, h) -> do
hSetEncoding h utf8
hPutStr h input
hFlush h
hClose h
withFile filePath ReadMode $ \hIn -> do
hSetEncoding hIn utf8
bracket (hDuplicate stdin) restoreStdin $ \_ -> do
hDuplicateTo hIn stdin
hSetEncoding stdin utf8
action
where
restoreStdin orig = hDuplicateTo orig stdin >> hClose orig
cleanup (fp, _) = removeFile fp
withStdout :: IO a -> IO (String, a)
withStdout action =
bracket
(openTempFile "." "stdoutXXXXXX.tmp")
cleanup
( \(path, hTmp) -> do
hSetEncoding hTmp utf8
oldOut <- hDuplicate stdout
oldErr <- hDuplicate stderr
hDuplicateTo hTmp stdout
hDuplicateTo hTmp stderr
result <-
action `finally` do
hFlush stdout
hFlush stderr
hDuplicateTo oldOut stdout >> hClose oldOut
hDuplicateTo oldErr stderr >> hClose oldErr
hClose hTmp
captured <- readFile path
_ <- evaluate (length captured)
return (captured, result)
)
where
cleanup (fp, _) = removeFile fp
withTempFile :: String -> ((FilePath, Handle) -> IO a) -> IO a
withTempFile pattern =
bracket
(openTempFile "." pattern)
(\(path, _) -> removeFile path)
testCLI' :: [String] -> [String] -> Either ExitCode () -> Expectation
testCLI' args outputs exit = do
(out, result) <- withStdout (try (runCLI args) :: IO (Either ExitCode ()))
forM_
outputs
( \output ->
unless (output `isInfixOf` out) $
expectationFailure
("Expected that output contains:\n" ++ output ++ "\nbut got:\n" ++ out)
)
result `shouldBe` exit
testCLISucceeded :: [String] -> [String] -> Expectation
testCLISucceeded args outputs = testCLI' args outputs (Right ())
testCLIFailed :: [String] -> [String] -> Expectation
testCLIFailed args outputs = testCLI' args outputs (Left (ExitFailure 1))
resource :: String -> String
resource file = "test-resources/cli/" <> file
rule :: String -> String
rule file = "--rule=" <> resource file
spec :: Spec
spec = do
it "prints version" $
testCLISucceeded ["--version"] [showVersion version]
it "prints help" $
testCLISucceeded
["--help"]
["Phino - CLI Manipulator of 𝜑-Calculus Expressions", "Usage:"]
it "prints debug info with --log-level=DEBUG" $
withStdin "Q -> [[]]" $
testCLISucceeded ["rewrite", "--log-level=DEBUG"] ["[DEBUG]:"]
describe "rewriting" $ do
describe "fails" $ do
it "with --input=latex" $
withStdin "" $
testCLIFailed
["rewrite", "--input=latex"]
["The value 'latex' can't be used for '--input' option"]
it "with negative --max-depth" $
withStdin "" $
testCLIFailed
["rewrite", "--max-depth=-1"]
["--max-depth must be positive"]
it "with --normalize and --must=1" $
withStdin "Q -> [[ x -> [[ y -> 5 ]].y ]].x" $
testCLIFailed
["rewrite", "--max-cycles=2", "--max-depth=1", "--normalize", "--must=1"]
["it's expected rewriting cycles to be in range [1], but rewriting has already reached 2"]
it "when --in-place is used without input file" $
withStdin "Q -> [[ ]]" $
testCLIFailed
["rewrite", "--in-place"]
["--in-place requires an input file"]
it "when --in-place is used with --target" $
withTempFile "inplaceXXXXXX.phi" $ \(path, h) -> do
hPutStr h "Q -> [[ ]]"
hClose h
testCLIFailed
["rewrite", "--in-place", "--target=output.phi", path]
["--in-place and --target cannot be used together"]
it "with --depth-sensitive" $
withStdin "Q -> [[ x -> \"x\"]]" $
testCLIFailed
["rewrite", "--depth-sensitive", "--max-depth=1", "--max-cycles=1", rule "infinite.yaml"]
["[ERROR]: With option --depth-sensitive it's expected rewriting iterations amount does not reach the limit: --max-depth=1"]
it "with looping rules" $
withStdin "Q -> [[ x -> \"0\" ]]" $
testCLIFailed
["rewrite", rule "first.yaml", rule "second.yaml", "--max-depth=1", "--max-cycles=3"]
["it seems rewriting is looping"]
it "with wrong attribute and valid error message" $
testCLIFailed
["rewrite", resource "with-$this-attribute.phi"]
[ "[ERROR]: Couldn't parse given phi program, cause: program:10:13:",
"10 | $this ↦ ⟦⟧",
" | ^^",
"unexpected \"$t\""
]
it "with --output != latex and --nonumber" $
withStdin "{[[]]}" $
testCLIFailed
["rewrite", "--nonumber", "--output=xmir"]
["The --nonumber option can stay together with --output=latex only"]
it "with --omit-listing and --output != xmir" $
withStdin "{[[]]}" $
testCLIFailed
["rewrite", "--omit-listing", "--output=phi"]
["--omit-listing"]
it "with --omit-comments and --output != xmir" $
withStdin "{[[]]}" $
testCLIFailed
["rewrite", "--omit-comments", "--output=phi"]
["--omit-comments"]
it "with --expression and --output != latex" $
withStdin "{[[]]}" $
testCLIFailed
["rewrite", "--expression=foo", "--output=phi"]
["--expression option can stay together with --output=latex only"]
it "with --label and --output != latex" $
withStdin "{[[]]}" $
testCLIFailed
["rewrite", "--label=foo", "--output=phi"]
["--label option can stay together with --output=latex only"]
it "with wrong --hide option" $
withStdin "{[[]]}" $
testCLIFailed
["rewrite", "--hide=Q.x(Q.y)"]
["[ERROR]: Invalid set of arguments: Only dispatch expression", "but given: Φ.x( Φ.y )"]
it "saves steps to dir with --steps-dir" $ do
let dir = "test-steps-temp"
dirExists <- doesDirectoryExist dir
when dirExists (removeDirectoryRecursive dir)
withStdin "Q -> [[ x -> \"hello\"]]" $ do
testCLISucceeded
["rewrite", rule "infinite.yaml", "--max-cycles=2", "--max-depth=2", "--steps-dir=" ++ dir, "--sweet"]
["hello_hi_hi"]
(`shouldBe` True) <$> doesDirectoryExist dir
files <- listDirectory dir
length files `shouldBe` 4
(`shouldBe` True) <$> doesFileExist (dir ++ "/00001.phi")
(`shouldBe` True) <$> doesFileExist (dir ++ "/00003.phi")
removeDirectoryRecursive dir
it "desugares without any rules flag from file" $
testCLISucceeded
["rewrite", resource "desugar.phi"]
["Φ ↦ ⟦\n foo ↦ Φ.org.eolang,\n ρ ↦ ∅\n⟧"]
it "desugares with without any rules flag from stdin" $
withStdin "{[[foo ↦ QQ]]}" $
testCLISucceeded ["rewrite"] ["Φ ↦ ⟦\n foo ↦ Φ.org.eolang,\n ρ ↦ ∅\n⟧"]
it "rewrites with single rule" $
withStdin "{T(x -> Q.y)}" $
testCLISucceeded ["rewrite", "--rule=resources/dc.yaml"] ["Φ ↦ ⊥"]
it "normalizes with --normalize flag" $
testCLISucceeded
["rewrite", "--normalize", resource "normalize.phi"]
[ unlines
[ "Φ ↦ ⟦",
" x ↦ ⟦",
" ρ ↦ ⟦",
" y ↦ ⟦ ρ ↦ ∅ ⟧,",
" ρ ↦ ∅",
" ⟧",
" ⟧,",
" ρ ↦ ∅",
"⟧"
]
]
it "normalizes from stdin" $
withStdin "Φ ↦ ⟦ a ↦ ⟦ b ↦ ∅ ⟧ (b ↦ [[ ]]) ⟧" $
testCLISucceeded
["rewrite", "--normalize"]
[ unlines
[ "Φ ↦ ⟦",
" a ↦ ⟦",
" b ↦ ⟦ ρ ↦ ∅ ⟧,",
" ρ ↦ ∅",
" ⟧,",
" ρ ↦ ∅",
"⟧"
]
]
it "rewrites with --sweet flag" $
withStdin "Q -> [[ x -> 5]]" $
testCLISucceeded
["rewrite", "--sweet"]
["{⟦\n x ↦ 5\n⟧}"]
it "rewrites as XMIR" $
withStdin "Q -> [[ x -> Q.y ]]" $
testCLISucceeded
["rewrite", "--output=xmir"]
["<?xml version=\"1.0\" encoding=\"UTF-8\"?>", "<object", " <o base=\"Φ.y\" name=\"x\"/>"]
it "rewrites as LaTeX" $
withStdin "Q -> [[ x_o -> QQ.z(y -> 5), q$ -> T, w -> $, ^ -> Q, @ -> 1, y -> \"H$@^M\", L> Fu_nc ]]" $
testCLISucceeded
["rewrite", "--output=latex", "--sweet"]
[ "\\begin{phiquation}",
"\\Big\\{[[\n",
" |x\\char95{}o| -> QQ.|z|(\n",
" |y| -> 5\n",
" ),\n",
" |q\\char36{}| -> T,\n",
" |w| -> $,\n",
" ^ -> Q,\n",
" @ -> 1,\n",
" |y| -> \"H$@^M\",\n",
" L> |Fu\\char95{}nc|\n",
"]]\\Big\\}",
"\\end{phiquation}"
]
it "rewrites as LaTeX without numeration" $
withStdin "Q -> [[ x -> 5 ]]" $
testCLISucceeded
["rewrite", "--output=latex", "--sweet", "--nonumber", "--flat"]
[ "\\begin{phiquation*}",
"\\Big\\{[[ |x| -> 5 ]]\\Big\\}",
"\\end{phiquation*}"
]
it "rewrite as LaTeX with expression name" $
withStdin "Q -> [[ x -> 5 ]]" $
testCLISucceeded
["rewrite", "--output=latex", "--sweet", "--flat", "--expression=foo"]
[ "\\begin{phiquation}",
"\\phiExpression{foo} \\Big\\{[[ |x| -> 5 ]]\\Big\\}",
"\\end{phiquation}"
]
it "rewrite as LaTeX with label name" $
withStdin "Q -> [[ x -> 5 ]]" $
testCLISucceeded
["rewrite", "--output=latex", "--sweet", "--flat", "--label=foo"]
[ "\\begin{phiquation}\n\\label{foo}\n",
"\\Big\\{[[ |x| -> 5 ]]\\Big\\}\n",
"\\end{phiquation}"
]
it "rewrites with XMIR as input" $
withStdin "<object><o name=\"app\"><o name=\"x\" base=\"Φ.number\"/></o></object>" $
testCLISucceeded
["rewrite", "--input=xmir", "--sweet"]
[ unlines
[ "{⟦",
" app ↦ ⟦",
" x ↦ Φ.number",
" ⟧",
"⟧}"
]
]
it "rewrites as XMIR with omit-listing flag" $
withStdin "Q -> [[ x -> Q.y ]]" $
testCLISucceeded
["rewrite", "--output=xmir", "--omit-listing"]
["<?xml version=\"1.0\" encoding=\"UTF-8\"?>", "<object", "<listing>1 line(s)</listing>", " <o base=\"Φ.y\" name=\"x\"/>"]
it "does not fail on exactly 1 rewriting" $
withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $
testCLISucceeded
["rewrite", rule "simple.yaml", "--must=1", "--sweet"]
["x ↦ \"bar\""]
it "prints many programs with --sequence" $
withStdin "{[[ x -> \"foo\" ]]}" $
testCLISucceeded
[ "rewrite",
rule "first.yaml",
rule "second.yaml",
"--max-depth=1",
"--max-cycles=2",
"--sequence",
"--sweet",
"--flat"
]
[ unlines
[ "{⟦ x ↦ \"foo\" ⟧}",
"{Φ.x( y ↦ \"foo\" )}",
"{⟦ x ↦ \"foo\" ⟧}"
]
]
it "prints only one latex preamble with --sequence" $
withStdin "{[[ x -> \"foo\" ]]}" $
testCLISucceeded
[ "rewrite",
rule "first.yaml",
rule "second.yaml",
"--max-depth=1",
"--max-cycles=2",
"--sequence",
"--sweet",
"--flat",
"--output=latex"
]
[ unlines
[ "\\begin{phiquation}",
"\\Big\\{[[ |x| -> \"foo\" ]]\\Big\\} \\leadsto_{\\nameref{r:first}}",
" \\leadsto \\Big\\{Q.|x|( |y| -> \"foo\" )\\Big\\} \\leadsto_{\\nameref{r:second}}",
" \\leadsto \\Big\\{[[ |x| -> \"foo\" ]]\\Big\\}",
"\\end{phiquation}"
]
]
it "prints input as listing in XMIR" $
withStdin "{[[ app -> [[]] ]]}" $
testCLISucceeded
["rewrite", "--output=xmir", "--omit-comments", "--sweet", "--flat"]
[" <listing>{[[ app -> [[]] ]]}</listing>"]
it "print program in listing in XMIRs with --sequence" $
withStdin "{[[ x -> \"foo\" ]]}" $
testCLISucceeded
["rewrite", "--output=xmir", "--omit-comments", "--sweet", "--flat", "--sequence", rule "simple.yaml"]
[" <listing>{⟦ x ↦ \"foo\" ⟧}</listing>", " <listing>{⟦ x ↦ \"bar\" ⟧}</listing>"]
describe "must range tests" $ do
describe "fails" $ do
it "when cycles exceed range ..1" $
withStdin "Q -> [[ x -> [[ y -> 5 ]].y ]].x" $
testCLIFailed
["rewrite", "--max-depth=1", "--max-cycles=2", "--normalize", "--must=..1"]
["it's expected rewriting cycles to be in range [..1], but rewriting has already reached 2"]
it "when cycles below range 2.." $
withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $
testCLIFailed
["rewrite", rule "simple.yaml", "--must=2.."]
["it's expected rewriting cycles to be in range [2..], but rewriting stopped after 1"]
it "with invalid range 5..3" $
withStdin "Q -> [[ ]]" $
testCLIFailed
["rewrite", "--must=5..3"]
["cannot parse value `5..3'"]
it "with negative in range -1..5" $
withStdin "Q -> [[ ]]" $
testCLIFailed
["rewrite", "--must=-1..5"]
["cannot parse value `-1..5'"]
it "with malformed range syntax" $
withStdin "Q -> [[ ]]" $
testCLIFailed
["rewrite", "--must=3...5"]
["cannot parse value `3...5'"]
it "accepts range ..5 (0 to 5 cycles)" $
withStdin "Q -> [[ ]]" $
testCLISucceeded ["rewrite", "--must=..5", "--sweet"] ["{⟦⟧}"]
it "accepts range 0..0 (exactly 0 cycles)" $
withStdin "Q -> [[ ]]" $
testCLISucceeded ["rewrite", "--must=0..0", "--sweet"] ["{⟦⟧}"]
it "accepts range 1..1 (exactly 1 cycle)" $
withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $
testCLISucceeded
["rewrite", rule "simple.yaml", "--must=1..1", "--sweet"]
["x ↦ \"bar\""]
it "accepts range 1..3 when 1 cycle happens" $
withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $
testCLISucceeded
["rewrite", rule "simple.yaml", "--must=1..3", "--sweet"]
["x ↦ \"bar\""]
it "accepts range 0.. (0 or more)" $
withStdin "Q -> [[ ]]" $
testCLISucceeded ["rewrite", "--must=0..", "--sweet"] ["{⟦⟧}"]
it "prints to target file" $
withStdin "Q -> [[ ]]" $
withTempFile "targetXXXXXX.tmp" $ \(path, h) -> do
hClose h
testCLISucceeded
["rewrite", "--sweet", printf "--target=%s" path]
[printf "The command result was saved in '%s'" path]
content <- readFile path
content `shouldBe` "{⟦⟧}"
it "modifies file in-place" $
withTempFile "inplaceXXXXXX.phi" $ \(path, h) -> do
hPutStr h "Q -> [[ x -> \"foo\" ]]"
hClose h
testCLISucceeded
["rewrite", rule "simple.yaml", "--in-place", "--sweet", path]
[printf "The file '%s' was modified in-place" path]
content <- readFile path
content `shouldBe` "{⟦\n x ↦ \"bar\"\n⟧}"
it "rewrites with cycles" $
withStdin "Q -> [[ x -> \"x\" ]]" $
testCLISucceeded
["rewrite", "--sweet", rule "infinite.yaml", "--max-depth=1", "--max-cycles=2"]
[ unlines
[ "{⟦",
" x ↦ \"x_hi_hi\"",
"⟧}"
]
]
it "hides default package" $
withStdin "{[[ org -> [[ eolang -> [[ number -> [[]] ]]]], x -> 42 ]]}" $
testCLISucceeded
["rewrite", "--sweet", "--flat", "--hide=Q.org"]
["{⟦ x ↦ 42 ⟧}"]
it "hides several FQNs" $
withStdin "{[[ org -> [[ eolang -> Q.x, yegor256 -> Q.y ]], x -> 42 ]]}" $
testCLISucceeded
["rewrite", "--sweet", "--flat", "--hide=Q.org.eolang", "--hide=Q.org.yegor256"]
["{⟦ org ↦ ⟦⟧, x ↦ 42 ⟧}"]
it "prints in line with --flat" $
withStdin "Q -> [[ x -> 5, y -> \"hey\", z -> [[ w -> [[ ]] ]] ]]" $
testCLISucceeded
["rewrite", "--sweet", "--flat"]
["{⟦ x ↦ 5, y ↦ \"hey\", z ↦ ⟦ w ↦ ⟦⟧ ⟧ ⟧}"]
describe "dataize" $ do
it "dataizes simple program" $
withStdin "Q -> [[ D> 01- ]]" $
testCLISucceeded ["dataize"] ["01-"]
it "fails to dataize" $
withStdin "Q -> [[ ]]" $
testCLIFailed ["dataize"] ["[ERROR]: Could not dataize given program"]
describe "explain" $ do
it "explains single rule" $
testCLISucceeded
["explain", "--rule=resources/copy.yaml"]
["\\documentclass{article}", "\\usepackage{amsmath}", "\\begin{document}", "\\rule{COPY}", "\\end{document}"]
it "explains multiple rules" $
testCLISucceeded
["explain", "--rule=resources/copy.yaml", "--rule=resources/alpha.yaml"]
["\\documentclass{article}", "\\rule{COPY}", "\\rule{ALPHA}"]
it "explains normalization rules" $
testCLISucceeded
["explain", "--normalize"]
["\\documentclass{article}", "\\begin{document}", "\\end{document}"]
it "fails with no rules specified" $
testCLIFailed
["explain"]
["Either --rule or --normalize must be specified"]
it "writes to target file" $
bracket
(openTempFile "." "explainXXXXXX.tex")
(\(path, _) -> removeFile path)
( \(path, h) -> do
hClose h
testCLISucceeded
["explain", "--normalize", printf "--target=%s" path]
[printf "was saved in '%s'" path]
content <- readFile path
content `shouldContain` "\\documentclass{article}"
content `shouldContain` "\\begin{document}"
)
describe "merge" $ do
it "merges single program" $
testCLISucceeded
["merge", resource "desugar.phi", "--sweet", "--flat"]
["{⟦ foo ↦ Φ̇ ⟧}"]
it "merges EO programs" $
testCLISucceeded
["merge", "--sweet", resource "number.phi", resource "bytes.phi", resource "string.phi"]
[ unlines
[ "{⟦",
" org ↦ ⟦",
" eolang ↦ ⟦",
" number ↦ ⟦",
" φ ↦ ∅",
" ⟧,",
" bytes ↦ ⟦",
" data ↦ ∅",
" ⟧,",
" string ↦ ⟦",
" φ ↦ ∅",
" ⟧,",
" λ ⤍ Package",
" ⟧,",
" λ ⤍ Package",
" ⟧",
"⟧}"
]
]
it "fails on merging non formations" $
testCLIFailed
["merge", resource "dispatch.phi", resource "number.phi"]
["Invalid program format, only programs with top level formations are supported for 'merge' command"]
it "fails on merging conflicted bindings" $
testCLIFailed
["merge", resource "foo.phi", resource "desugar.phi"]
["Can't merge two bindings, conflict found"]
it "fails on merging empty list of programs" $
testCLIFailed
["merge"]
["At least one input file must be specified for 'merge' command"]