phino 0.0.0.19 → 0.0.0.20
raw patch · 8 files changed
+74/−18 lines, 8 filesPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
API changes (from Hackage documentation)
+ Functions: randomStrings :: IORef (Set String)
+ Misc: pattern DataNumber :: Bytes -> Expression
+ Misc: pattern DataString :: Bytes -> Expression
Files
- phino.cabal +1/−1
- src/Dataize.hs +3/−3
- src/Functions.hs +47/−3
- src/Misc.hs +8/−0
- src/Parser.hs +9/−6
- src/Pretty.hs +2/−2
- src/XMIR.hs +2/−2
- test/ParserSpec.hs +2/−1
phino.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: phino-version: 0.0.0.19+version: 0.0.0.20 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>
src/Dataize.hs view
@@ -165,7 +165,7 @@ let first = either toDouble id (btsToNum left') second = either toDouble id (btsToNum right') sum = first + second- pure (Just (DataObject "number" (numToBts sum)))+ pure (Just (DataNumber (numToBts sum))) _ -> pure Nothing atom "L_org_eolang_number_times" self ctx = do left <- dataize' (ExDispatch self (AtLabel "x")) ctx@@ -175,7 +175,7 @@ let first = either toDouble id (btsToNum left') second = either toDouble id (btsToNum right') sum = first * second- pure (Just (DataObject "number" (numToBts sum)))+ pure (Just (DataNumber (numToBts sum))) _ -> pure Nothing atom "L_org_eolang_number_eq" self ctx = do x <- dataize' (ExDispatch self (AtLabel "x")) ctx@@ -185,7 +185,7 @@ let self' = either toDouble id (btsToNum rho') first = either toDouble id (btsToNum x') if self' == first- then pure (Just (DataObject "number" (numToBts first)))+ then pure (Just (DataNumber (numToBts first))) else pure (Just (ExDispatch self (AtLabel "y"))) _ -> pure Nothing atom func _ _ = throwIO (userError (printf "Atom '%s' does not exist" func))
src/Functions.hs view
@@ -8,15 +8,27 @@ import Ast import Builder import Control.Exception (throwIO)+import Control.Monad (replicateM) import qualified Data.ByteString.Char8 as B+import Data.Char (intToDigit)+import Data.IORef+import Data.Set (Set)+import qualified Data.Set+import GHC.IO (unsafePerformIO) import Matcher import Misc+import Numeric (showHex) import Pretty import Regexp+import System.Random (randomRIO) import Term import Text.Printf (printf) import Yaml +randomStrings :: IORef (Set String)+{-# NOINLINE randomStrings #-}+randomStrings = unsafePerformIO (newIORef Data.Set.empty)+ argToStrBytes :: ExtraArgument -> Subst -> Program -> IO String argToStrBytes (ArgBytes bytes) subst _ = do bts <- buildBytesThrows bytes subst@@ -67,15 +79,18 @@ let cactoos = "a🌵" tau = if idx == 0 then cactoos else cactoos ++ show idx in if tau `elem` attrs then randomTau (idx + 1) attrs else tau+buildTermFromFunction "dataize" [ArgBytes bytes] subst _ = do+ bts <- buildBytesThrows bytes subst+ pure (TeBytes bts) buildTermFromFunction "dataize" [ArgExpression expr] subst _ = do (expr', _) <- buildExpressionThrows expr subst case expr' of DataObject _ bytes -> pure (TeBytes bytes)- _ -> throwIO (userError "Only data objects are supported by 'dataize' function now")+ _ -> throwIO (userError "Only data objects and bytes are supported by 'dataize' function now") buildTermFromFunction "dataize" _ _ _ = throwIO (userError "Function dataize() requires exactly 1 argument as expression") buildTermFromFunction "concat" args subst prog = do args' <- traverse (\arg -> argToStrBytes arg subst prog) args- pure (TeExpression (DataObject "string" (strToBts (concat args'))))+ pure (TeExpression (DataString (strToBts (concat args')))) buildTermFromFunction "sed" [tgt, ptn] subst prog = do [tgt', ptn'] <- traverse (\arg -> argToStrBytes arg subst prog) [tgt, ptn] (pat, rep, global) <- parse (B.pack ptn')@@ -84,7 +99,7 @@ if global then replaceAll regex rep (B.pack tgt') else replaceFirst regex rep (B.pack tgt')- pure (TeExpression (DataObject "string" (strToBts (B.unpack res))))+ pure (TeExpression (DataString (strToBts (B.unpack res)))) where parse :: B.ByteString -> IO (B.ByteString, B.ByteString, Bool) parse input =@@ -98,4 +113,33 @@ _ -> throwIO (userError "sed pattern must be in format s/pat/rep/[g]") _ -> throwIO (userError "sed pattern must start with s/") buildTermFromFunction "sed" _ _ _ = throwIO (userError "Function sed() requires exactly 2 dataizable arguments")+buildTermFromFunction "random-string" [arg] subst prog = do+ pat <- argToStrBytes arg subst prog+ set <- readIORef randomStrings+ str <- regenerate pat set+ pure (TeExpression (DataString (strToBts str)))+ where+ regenerate :: String -> Set String -> IO String+ regenerate pat set = do+ next <- randomString pat+ if next `Data.Set.member` set+ then regenerate pat set+ else do+ modifyIORef' randomStrings (Data.Set.insert next)+ pure next+ randomString :: String -> IO String+ randomString [] = pure []+ randomString ('%' : ch : rest) = do+ rep <- case ch of+ 'x' -> replicateM 8 $ do+ v <- randomRIO (0, 15)+ pure (intToDigit v)+ 'd' -> show <$> randomRIO (0 :: Int, 9999)+ _ -> pure ['%', ch]+ next <- randomString rest+ pure (rep ++ next)+ randomString (ch : rest) = do+ rest' <- randomString rest+ pure (ch : rest')+buildTermFromFunction "random-string" _ _ _ = throwIO (userError "Function random-string() requires exactly 1 dataizable argument") buildTermFromFunction func _ _ _ = throwIO (userError (printf "Function %s() is not supported or does not exist" func))
src/Misc.hs view
@@ -20,6 +20,8 @@ shuffle, btsToUnescapedStr, pattern DataObject,+ pattern DataString,+ pattern DataNumber, ) where @@ -72,6 +74,12 @@ ) ) = Just (label, bts) matchDataoObject _ = Nothing++pattern DataString :: Bytes -> Expression+pattern DataString bts = DataObject "string" bts++pattern DataNumber :: Bytes -> Expression+pattern DataNumber bts = DataObject "number" bts pattern DataObject :: String -> Bytes -> Expression pattern DataObject label bts <- (matchDataoObject -> Just (label, bts))
src/Parser.hs view
@@ -144,12 +144,15 @@ global :: Parser String global = choice [symbol "Q", symbol "Φ"] +metaSuffix :: Parser String+metaSuffix = lexeme (many (oneOf ('_' : '-' : ['0' .. '9'] ++ ['a' .. 'z'] ++ ['A' .. 'Z']) <?> "meta suffix"))+ meta :: Char -> Parser String meta ch = do _ <- char '!' c <- char ch- ds <- lexeme (many digitChar)- return (c : ds)+ suf <- metaSuffix+ return (c : suf) meta' :: Char -> String -> Parser String meta' ch uni =@@ -157,8 +160,8 @@ [ meta ch, do _ <- symbol uni- ds <- lexeme (many digitChar)- return (ch : ds)+ suf <- metaSuffix+ return (ch : suf) ] byte :: Parser String@@ -332,11 +335,11 @@ Just '-' -> negate unsigned _ -> unsigned )- return (DataObject "number" (numToBts num)),+ return (DataNumber (numToBts num)), lexeme $ do _ <- char '"' str <- manyTill (choice [escapedChar, noneOf ['\\', '"']]) (char '"')- return (DataObject "string" (strToBts str)),+ return (DataString (strToBts str)), try (ExMeta <$> meta' 'e' "𝑒"), ExDispatch ExThis <$> fullAttribute ]
src/Pretty.hs view
@@ -126,8 +126,8 @@ instance Pretty (Formatted Expression) where pretty (Formatted (SWEET, ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))) = pretty "Φ̇"- pretty (Formatted (SWEET, DataObject "string" bytes)) = pretty "\"" <> pretty (btsToStr bytes) <> pretty "\""- pretty (Formatted (SWEET, DataObject "number" bytes)) = either pretty pretty (btsToNum bytes)+ pretty (Formatted (SWEET, DataString bytes)) = pretty "\"" <> pretty (btsToStr bytes) <> pretty "\""+ pretty (Formatted (SWEET, DataNumber bytes)) = either pretty pretty (btsToNum bytes) pretty (Formatted (SWEET, DataObject other bytes)) = pretty (Formatted (SALTY, DataObject other bytes)) pretty (Formatted (mode, ExFormation [binding])) = case binding of BiTau _ _ -> vsep [pretty "⟦", indent 2 (pretty (Formatted (mode, binding))), pretty "⟧"]
src/XMIR.hs view
@@ -92,7 +92,7 @@ if head base == '.' || not (null children) then pure ('.' : attr', [object [("base", base)] children]) else pure (base ++ ('.' : attr'), children)-expression (DataObject "number" bytes) XmirContext {..} =+expression (DataNumber bytes) XmirContext {..} = let bts = object [("as", prettyAttribute (AtAlpha 0)), ("base", "Q.org.eolang.bytes")]@@ -106,7 +106,7 @@ bts ] )-expression (DataObject "string" bytes) XmirContext {..} =+expression (DataString bytes) XmirContext {..} = let bts = object [("as", prettyAttribute (AtAlpha 0)), ("base", "Q.org.eolang.bytes")]
test/ParserSpec.hs view
@@ -243,7 +243,8 @@ "[[x -> 1.00e+3, y -> 2.32e-4]]", "[[ x -> \"\\u0001\\u0001\"]]", "[[ x -> \"\\uD835\\uDF11\"]]",- "[[ x ↦ \"This plugin has \\x01\\x01\" ]]"+ "[[ x ↦ \"This plugin has \\x01\\x01\" ]]",+ "[[ !afoo -> !e1Some, !a-BAR -> !e_123someW, !Bhi123 ]]" ] (\expr -> it expr (parseExpression expr `shouldSatisfy` isRight))