diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,4 +16,14 @@ * made slicing more flexible (you can now change the length of the focused segment) -* made regex user perl style instead of POSIX style +* made regex use perl style instead of POSIX style + +## 0.2.0 -- 2024-03-10 + +* added "el", "kv", "key", "val", "atKey", "atIdx" focusers + +* switched from internally using scientific to Rational + +* fixed "regex" (it was very broken, lol) + +* added escaping support to string literals (only \") diff --git a/smh.cabal b/smh.cabal --- a/smh.cabal +++ b/smh.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: smh -version: 0.1.3.1 +version: 0.2.0 synopsis: String manipulation tool written in haskell description: String manipulation CLI tool based on optics category: CLI Tool @@ -24,9 +24,9 @@ main-is: Main.hs other-modules: Paths_smh autogen-modules: Paths_smh - build-depends: base ^>=4.17.2.1, + build-depends: base >= 4.17 && < 4.20, megaparsec >= 9.6.1 && < 9.7, - text >= 2.0.2 && < 2.1, + text >= 2.0.2 && < 2.2, lib hs-source-dirs: app default-language: Haskell2010 @@ -37,15 +37,14 @@ Focusers, Mappings, Parsers - build-depends: base ^>=4.17.2.1, + build-depends: base >= 4.17 && < 4.20, megaparsec >= 9.6.1 && < 9.7, lens >= 5.2.3 && < 5.3, - scientific >= 0.3.7 && < 0.4, - text >= 2.0.2 && < 2.1, + text >= 2.0.2 && < 2.2, array >= 0.5.4 && < 0.6, extra >= 1.7.14 && < 1.8, regex-pcre-builtin >= 0.95.2 && < 0.96, - loop >= 0.3.0 && < 0.4 + loop >= 0.3.0 && < 0.4, hs-source-dirs: src default-language: Haskell2010 @@ -54,13 +53,12 @@ main-is: Main.hs hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base ^>=4.17.2.1, + build-depends: base >= 4.17 && < 4.20, tasty, tasty-hunit, process, extra >= 1.7.14 && < 1.8, lib, - scientific >= 0.3.7 && < 0.4, - text >= 2.0.2 && < 2.1 + text >= 2.0.2 && < 2.2 default-language: Haskell2010 diff --git a/src/Common.hs b/src/Common.hs --- a/src/Common.hs +++ b/src/Common.hs @@ -1,9 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE KindSignatures #-} module Common(module Common) where -import Control.Applicative (empty) +import Control.Applicative (empty, (<|>)) import Control.Lens (Lens', Traversal', lens, (^..)) import Control.Loop (numLoop) import Control.Monad (forM_) @@ -13,8 +15,7 @@ import Data.Data (Data) import Data.List (nub, sort) import Data.List.Extra (nubOrd) -import Data.Scientific (Scientific, floatingOrInteger, - fromFloatDigits, toRealFloat) +import Data.Ratio (denominator, numerator) import Data.STRef () import Data.Text (Text) import qualified Data.Text as T @@ -22,6 +23,7 @@ import Text.Megaparsec (Parsec, label) import Text.Megaparsec.Char (space1) import qualified Text.Megaparsec.Char.Lexer as L +import Text.Read (readMaybe) data Focus = FText !Text @@ -65,13 +67,10 @@ type Parser = Parsec Void Text -showScientific :: Scientific -> Text -showScientific n = case floatingOrInteger n :: Either Double Int of - Left d -> T.pack $ show d - Right i -> T.pack $ show i - -safeDiv :: Scientific -> Scientific -> Scientific -safeDiv a b = fromFloatDigits (toRealFloat a / toRealFloat b) +showRational :: Rational -> Text +showRational n = if denominator n == 1 + then T.pack $ show (numerator n) + else T.pack $ show (fromInteger (numerator n) / fromInteger (denominator n)) data Range = RangeSingle !Int @@ -99,7 +98,7 @@ data Evaluatable = EText !Text - | ENumber !Scientific + | ENumber !Rational | EFocuser { evalFocuserUnsafe :: !Focuser } data IfExpr @@ -135,8 +134,8 @@ integer :: Parser Int integer = label "integer" $ lexeme $ L.signed ws L.decimal -scient :: Parser Scientific -scient = label "number" $ lexeme $ L.signed ws L.scientific +rational :: Parser Rational +rational = toRational <$> label "number" (lexeme $ L.signed ws L.scientific) mapText :: (Char -> a) -> Text -> [a] mapText f = T.foldr (\c cs -> f c : cs) [] @@ -164,3 +163,19 @@ mappingTo (FTrav trav) focus = case (focus, focus ^.. trav) of (FText _, [FText str]) -> FText str _ -> focus + +fromIndexes :: Int -> Text -> [(Int, Int)] -> ([Text], [Text]) +fromIndexes _ str [] = ([str], []) +fromIndexes offset str ((i, j) : is) = + let (nonMatch, T.splitAt j -> (match, str')) = T.splitAt (i - offset) str + (nonMatches, matches) = fromIndexes (i + j) str' is + in (nonMatch : nonMatches, match : matches) + +readMaybeRational :: Text -> Maybe Rational +readMaybeRational s = (toRational <$> readMaybeInteger s) <|> (toRational <$> readMaybeDouble s) + +readMaybeInteger :: Text -> Maybe Integer +readMaybeInteger = readMaybe . T.unpack + +readMaybeDouble :: Text -> Maybe Double +readMaybeDouble = readMaybe . T.unpack diff --git a/src/Focusers.hs b/src/Focusers.hs --- a/src/Focusers.hs +++ b/src/Focusers.hs @@ -3,19 +3,20 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ViewPatterns #-} module Focusers where import Common (Comparison (..), Evaluatable (..), Focus (..), Focuser (..), IfExpr (..), - Mapping, Oper (..), Quantor (..), + Mapping, Oper (..), Parser, Quantor (..), Range (RangeSingle), _toListUnsafe, - composeFocusers, getIndexes, - makeFilteredText, mapText, safeDiv, - showScientific, toListUnsafe, - toTextUnsafe, unsort) + composeFocusers, fromIndexes, getIndexes, + lexeme, makeFilteredText, mapText, + readMaybeRational, showRational, symbol, + toListUnsafe, toTextUnsafe, unsort, ws) +import Control.Applicative ((<|>)) import Control.Lens (lens, partsOf, (^..)) +import Control.Monad (void, when, zipWithM) import Data.Char (isAlpha, isAlphaNum, isDigit, isLower, isSpace, isUpper) import Data.Data.Lens (biplate) @@ -24,9 +25,13 @@ import Data.List (sortBy, transpose) import Data.Maybe (mapMaybe) import Data.Ord (comparing) -import Data.Scientific (Scientific) +import Data.Ratio (denominator) import Data.Text (Text) import qualified Data.Text as T +import Text.Megaparsec (anySingle, anySingleBut, between, choice, + empty, getOffset, many, optional, + parseMaybe, satisfy, sepBy, some, try) +import Text.Megaparsec.Char (char) import Text.Read (readMaybe) import Text.Regex.PCRE (AllMatches (getAllMatches), (=~)) import Text.Regex.PCRE.Text () @@ -271,38 +276,39 @@ getSum :: Focus -> Focus getSum focus = case focus of - FList _ -> FText $ showScientific $ sum $ - mapMaybe readMaybeScientific $ focus ^.. biplate - FText s -> FText $ showScientific $ sum $ - mapMaybe (readMaybeScientific . T.singleton) $ T.unpack s + FList _ -> FText $ showRational $ sum $ + mapMaybe readMaybeRational $ focus ^.. biplate + FText s -> FText $ showRational $ sum $ + mapMaybe (readMaybeRational . T.singleton) $ T.unpack s focusProduct :: Focuser focusProduct = FTrav $ lens getProduct const getProduct :: Focus -> Focus getProduct focus = case focus of - FList _ -> FText $ showScientific $ product $ - mapMaybe readMaybeScientific $ focus ^.. biplate - FText s -> FText $ showScientific $ product $ - mapMaybe (readMaybeScientific . T.singleton) $ T.unpack s + FList _ -> FText $ showRational $ product $ + mapMaybe readMaybeRational $ focus ^.. biplate + FText s -> FText $ showRational $ product $ + mapMaybe (readMaybeRational . T.singleton) $ T.unpack s -focusAverage :: Scientific -> Focuser +focusAverage :: Rational -> Focuser focusAverage n = FTrav $ lens (getAverage n) const -getAverage :: Scientific -> Focus -> Focus +getAverage :: Rational -> Focus -> Focus getAverage n focus = case focus of - FList _ -> FText $ showScientific $ average n $ - mapMaybe readMaybeScientific $ focus ^.. biplate - FText s -> FText $ showScientific $ average n $ - mapMaybe (readMaybeScientific . T.singleton) $ T.unpack s + FList _ -> FText $ showRational $ average n $ + mapMaybe readMaybeRational $ focus ^.. biplate + FText s -> FText $ showRational $ average n $ + mapMaybe (readMaybeRational . T.singleton) $ T.unpack s -average :: Scientific -> [Scientific] -> Scientific +average :: Rational -> [Rational] -> Rational average n [] = n average _ xs = sum xs / fromIntegral (length xs) -readMaybeScientific :: Text -> Maybe Scientific -readMaybeScientific = readMaybe . T.unpack + + + focusIf :: IfExpr -> Focuser focusIf ifexpr = FTrav $ \f focus -> if focus `passesIf` ifexpr then f focus @@ -324,22 +330,22 @@ (QAny, QAll) -> any and results (QAny, QAny) -> any or results - evaluateEval :: Focus -> Evaluatable -> [Either Scientific Focus] + evaluateEval :: Focus -> Evaluatable -> [Either Rational Focus] evaluateEval focus eval = case eval of EText s -> [Right $ FText s] ENumber n -> [Left n] EFocuser (FTrav trav) -> Right <$> focus ^.. trav - applyOp :: Oper -> Either Scientific Focus -> Either Scientific Focus -> Bool + applyOp :: Oper -> Either Rational Focus -> Either Rational Focus -> Bool applyOp OpEq (Left n1) (Left n2) = n1 == n2 applyOp OpEq (Right f1) (Right f2) = f1 == f2 - applyOp OpEq (Left n1) (Right (FText s2)) = Just n1 == readMaybeScientific s2 - applyOp OpEq (Right (FText s1)) (Left n2) = readMaybeScientific s1 == Just n2 + applyOp OpEq (Left n1) (Right (FText s2)) = Just n1 == readMaybeRational s2 + applyOp OpEq (Right (FText s1)) (Left n2) = readMaybeRational s1 == Just n2 applyOp OpNe (Left n1) (Left n2) = n1 /= n2 - applyOp OpNe (Left n1) (Right (FText s2)) = case readMaybeScientific s2 of + applyOp OpNe (Left n1) (Right (FText s2)) = case readMaybeRational s2 of Just n2 -> n1 /= n2 Nothing -> False - applyOp OpNe (Right (FText s1)) (Left n2) = case readMaybeScientific s1 of + applyOp OpNe (Right (FText s1)) (Left n2) = case readMaybeRational s1 of Just n1 -> n1 /= n2 Nothing -> False applyOp OpNe (Right f1) (Right f2) = f1 /= f2 @@ -352,18 +358,18 @@ where applyOpOrd :: (forall a. Ord a => a -> a -> Bool) - -> Either Scientific Focus - -> Either Scientific Focus + -> Either Rational Focus + -> Either Rational Focus -> Bool applyOpOrd f (Left n1) (Left n2) = f n1 n2 - applyOpOrd f (Left n1) (Right (FText s2)) = case readMaybeScientific s2 of + applyOpOrd f (Left n1) (Right (FText s2)) = case readMaybeRational s2 of Just n2 -> f n1 n2 Nothing -> False - applyOpOrd f (Right (FText s1)) (Left n2) = case readMaybeScientific s1 of + applyOpOrd f (Right (FText s1)) (Left n2) = case readMaybeRational s1 of Just n1 -> f n1 n2 Nothing -> False applyOpOrd f (Right (FText s1)) (Right (FText s2)) = - case (readMaybeScientific s1, readMaybeScientific s2) of + case (readMaybeRational s1, readMaybeRational s2) of (Just n1, Just n2) -> f n1 n2 _ -> f s1 s2 applyOpOrd _ _ _ = False @@ -413,15 +419,7 @@ newMatches = map toTextUnsafe <$> traverse (f . FText) matches in FText . T.concat . interleave nonMatches <$> newMatches _ -> pure focus - where - fromIndexes :: Int -> Text -> [(Int, Int)] -> ([Text], [Text]) - fromIndexes _ str [] = ([str], []) - fromIndexes offset str ((i, j) : is) = - let (nonMatch, T.splitAt j -> (match, str')) = T.splitAt (i - offset) str - (nonMatches, matches) = fromIndexes (offset + i + j) str' is - in (nonMatch : nonMatches, match : matches) - focusFilter :: IfExpr -> Focuser focusFilter pred = focusCollect $ focusEach `composeFocusers` focusIf pred @@ -451,5 +449,167 @@ focusLength :: Focuser focusLength = FTrav $ \f focus -> case focus of - FText s -> f . FText . T.pack . show . T.length $ s + fs@(FText s) -> fs <$ f (FText . T.pack . show . T.length $ s) flst@(FList lst) -> flst <$ f (FText . T.pack . show . length $ lst) + +parseListElemIdxs :: Parser [(Int, Int)] +parseListElemIdxs = do + symbol "[" + idxs <- parseElemIdxs `sepBy` symbol "," + symbol "]" + pure idxs + +parseElemIdxs :: Parser (Int, Int) +parseElemIdxs = lexeme $ do + idx1 <- getOffset + skipListElem + idx2 <- getOffset + pure (idx1, idx2 - idx1) + +skipListElem :: Parser () +skipListElem = choice + [ inQuotes + , inDoubleQuotes + , inSquareBraces + , inParens + , inCurlyBraces + , escapingCommaSquareBrace] + >> void (optional (try $ ws >> skipListElem)) + +inQuotes = char '\'' >> escaping '\'' '\'' 1 +inDoubleQuotes = char '"' >> escaping '"' '"' 1 +inSquareBraces = char '[' >> escaping '[' ']' 1 +inParens = char '(' >> escaping '(' ')' 1 +inCurlyBraces = char '{' >> escaping '{' '}' 1 +escapingCommaSquareBrace = void $ some $ satisfy (\c -> c /= ',' && c /= ']' && not (isSpace c)) + +escaping :: Char -> Char -> Int -> Parser () +escaping start end depth = choice + [ char end >> if depth == 1 then return () else void (optional $ escaping start end (depth - 1)) + , char start >> void (optional $ escaping start end (depth + 1)) + , char '\\' >> anySingle >> void (optional $ escaping start end depth) + , anySingle >> void (optional $ escaping start end depth) + ] + +focusEl :: Focuser +focusEl = FTrav $ \f focus -> case focus of + FText s -> case parseMaybe parseListElemIdxs s of + Just idxs -> + let (nonMatches, matches) = fromIndexes 0 s idxs + newMatches = map toTextUnsafe <$> traverse (f . FText) matches + in FText . T.concat . interleave nonMatches <$> newMatches + Nothing -> pure focus + FList _ -> pure focus + +parseObjKVIdxs :: Parser [((Int, Int), (Int, Int))] +parseObjKVIdxs = do + symbol "{" + idxs <- parseKVIdxs `sepBy` symbol "," + symbol "}" + pure idxs + +parseKVIdxs :: Parser ((Int, Int), (Int, Int)) +parseKVIdxs = do + keyIdxs <- parseKeyIdxs + symbol ":" + valIdxs <- parseValIdxs + pure (keyIdxs, valIdxs) + +parseKeyIdxs :: Parser (Int, Int) +parseKeyIdxs = lexeme $ do + idx1 <- getOffset + skipKey + idx2 <- getOffset + pure (idx1, idx2 - idx1) + +skipKey :: Parser () +skipKey = choice + [ inQuotes + , inDoubleQuotes + , inSquareBraces + , inParens + , inCurlyBraces + , escapingColonCurlyBrace] + >> void (optional (try $ ws >> skipKey)) + +escapingColonCurlyBrace = void $ some $ satisfy (\c -> c /= ':' && c /= '}' && not (isSpace c)) + +parseValIdxs :: Parser (Int, Int) +parseValIdxs = lexeme $ do + idx1 <- getOffset + skipVal + idx2 <- getOffset + pure (idx1, idx2 - idx1) + +skipVal :: Parser () +skipVal = choice + [ inQuotes + , inDoubleQuotes + , inSquareBraces + , inParens + , inCurlyBraces + , escapingCommaCurlyBrace] + >> void (optional (try $ ws >> skipVal)) + +escapingCommaCurlyBrace = void $ some $ satisfy (\c -> c /= ',' && c /= '}' && not (isSpace c)) + +focusKV :: Focuser +focusKV = FTrav $ \f focus -> case focus of + FText s -> case parseMaybe parseObjKVIdxs s of + Just idxs -> + let idxs_ = concatMap (\(a, b) -> [a, b]) idxs + (nonMatches, matches) = fromIndexes 0 s idxs_ + matches_ = pairUp $ map FText matches + newMatches_ = map toListUnsafe <$> traverse (f . FList) matches_ + newMatches = map toTextUnsafe . concat <$> newMatches_ + in FText . T.concat . interleave nonMatches <$> newMatches + Nothing -> pure focus + FList _ -> pure focus + where + pairUp :: [a] -> [[a]] + pairUp [] = [] + pairUp (a1 : a2 : as) = [a1, a2] : pairUp as + pairUp _ = error "pairUp: list too short" + +data KeyType + = InQuotes Text + | InDoubleQuotes Text + | Default + +focusKey :: Focuser +focusKey = FTrav $ \f focus -> case focus of + FList [FText key, FText val] -> case stripKey key of + InQuotes key_ -> setKey val . (\k -> "'" <> k <> "'") . toTextUnsafe <$> f (FText key_) + InDoubleQuotes key_ -> setKey val . (\k -> "\"" <> k <> "\"") . toTextUnsafe <$> f (FText key_) + Default -> setKey val . toTextUnsafe <$> f (FText key) + FText _ -> + let FTrav trav = focusKV `composeFocusers` focusKey + in trav f focus + +stripKey :: Text -> KeyType +stripKey s + | T.index s 0 == '"' && T.index s (T.length s - 1) == '"' = + InDoubleQuotes $ T.drop 1 $ T.dropEnd 1 s + | T.index s 0 == '\'' && T.index s (T.length s - 1) == '\''= + InQuotes $ T.drop 1 $ T.dropEnd 1 s + | otherwise = Default + +setKey :: Text -> Text -> Focus +setKey val key = FList [FText key, FText val] + +focusVal :: Focuser +focusVal = FTrav $ \f focus -> case focus of + FList _ -> + let FTrav trav = focusIndex 1 + in trav f focus + FText _ -> + let FTrav trav = focusKV `composeFocusers` focusVal + in trav f focus + +focusAtKey :: Text -> Focuser +focusAtKey key = focusKV + `composeFocusers` focusIf (IfSingle $ Comparison (QAll, EFocuser focusKey) OpEq (QAll, EText key)) + `composeFocusers` focusVal + +focusAtIdx :: Int -> Focuser +focusAtIdx i = focusCollect focusEl `composeFocusers` focusIndex i diff --git a/src/Mappings.hs b/src/Mappings.hs --- a/src/Mappings.hs +++ b/src/Mappings.hs @@ -5,13 +5,12 @@ import Common (Evaluatable (..), Focus (FList, FText), Focuser (..), Mapping, Range, getIndexes, - makeFilteredText, mapText, safeDiv, - showScientific, toTextUnsafe) + makeFilteredText, mapText, + showRational, toTextUnsafe, readMaybeRational) import Control.Lens ((^..)) import Data.Char (toLower, toUpper) import Data.Function (on) import Data.List (sortBy) -import Data.Scientific (Scientific) import Data.Text (Text) import qualified Data.Text as T import Text.Read (readMaybe) @@ -31,7 +30,7 @@ mappingAppend :: Evaluatable -> Mapping mappingAppend (EText str') (FText str) = FText $ T.append str str' -mappingAppend (ENumber n) (FText str) = FText $ T.append str (showScientific n) +mappingAppend (ENumber n) (FText str) = FText $ T.append str (showRational n) mappingAppend (EFocuser (FTrav trav)) fstr@(FText str) = case fstr ^.. trav of [FText s] -> FText $ T.append str s _ -> fstr @@ -39,7 +38,7 @@ mappingPrepend :: Evaluatable -> Mapping mappingPrepend (EText str') (FText str) = FText $ T.append str' str -mappingPrepend (ENumber n) (FText str) = FText $ T.append (showScientific n) str +mappingPrepend (ENumber n) (FText str) = FText $ T.append (showRational n) str mappingPrepend (EFocuser (FTrav trav)) fstr@(FText str) = case fstr ^.. trav of [FText s] -> FText $ T.append s str _ -> fstr @@ -53,23 +52,23 @@ mappingLower (FText str) = FText $ T.toLower str mappingLower flist = flist -mappingMath :: (Scientific -> Scientific) -> Mapping -mappingMath f (FText str) = case readMaybe $ T.unpack str of +mappingMath :: (Rational -> Rational) -> Mapping +mappingMath f (FText str) = case readMaybeRational str of Nothing -> FText str - Just n -> FText $ showScientific $ f n + Just n -> FText $ showRational $ f n mappingMath _ flist = flist -mappingAdd :: Scientific -> Mapping +mappingAdd :: Rational -> Mapping mappingAdd = mappingMath . (+) -mappingSub :: Scientific -> Mapping +mappingSub :: Rational -> Mapping mappingSub = mappingMath . flip (-) -mappingMult :: Scientific -> Mapping +mappingMult :: Rational -> Mapping mappingMult = mappingMath . (*) -mappingDiv :: Scientific -> Mapping -mappingDiv = mappingMath . flip safeDiv +mappingDiv :: Rational -> Mapping +mappingDiv = mappingMath . flip (/) mappingPow :: Int -> Mapping mappingPow = mappingMath . flip (^^) diff --git a/src/Parsers.hs b/src/Parsers.hs --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -7,23 +7,25 @@ Oper (..), Parser, Quantor (..), Range (..), composeFocusers, focusTo, foldFocusers, foldMappings, integer, - lexeme, scient, symbol, mappingTo) + lexeme, mappingTo, rational, symbol) import Data.Char (isAlphaNum) import Data.Functor (($>)) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T -import Focusers (focusAverage, focusCollect, focusCols, - focusContains, focusEach, focusEndsWith, - focusFilter, focusId, focusIf, - focusIndex, focusIsAlpha, +import Focusers (escaping, focusAtIdx, focusAtKey, + focusAverage, focusCollect, focusCols, + focusContains, focusEach, focusEl, + focusEndsWith, focusFilter, focusId, + focusIf, focusIndex, focusIsAlpha, focusIsAlphaNum, focusIsDigit, focusIsLower, focusIsSpace, focusIsUpper, - focusLength, focusLines, focusMaxBy, - focusMaxLexBy, focusMinBy, focusMinLexBy, - focusProduct, focusRegex, focusSlice, - focusSortedBy, focusSortedLexBy, - focusSpace, focusStartsWith, focusSum, + focusKV, focusKey, focusLength, + focusLines, focusMaxBy, focusMaxLexBy, + focusMinBy, focusMinLexBy, focusProduct, + focusRegex, focusSlice, focusSortedBy, + focusSortedLexBy, focusSpace, + focusStartsWith, focusSum, focusVal, focusWords) import Mappings (mappingAbs, mappingAdd, mappingAppend, mappingDiv, mappingId, mappingLength, @@ -33,10 +35,11 @@ mappingSlice, mappingSortBy, mappingSortLexBy, mappingSub, mappingUpper) -import Text.Megaparsec (MonadParsec (try), anySingle, between, - choice, empty, label, many, noneOf, - notFollowedBy, optional, satisfy, sepBy, - sepBy1, takeWhile1P, (<|>)) +import Text.Megaparsec (MonadParsec (try), anySingle, + anySingleBut, between, choice, empty, + label, many, noneOf, notFollowedBy, + optional, satisfy, sepBy, sepBy1, + takeWhile1P, (<|>)) import Text.Megaparsec.Char (char, string) -- Focuser parsers @@ -89,6 +92,12 @@ , parseFocusContains , parseFocusStartsWith , parseFocusEndsWith + , symbol "el" $> focusEl + , symbol "kv" $> focusKV + , symbol "key" $> focusKey + , symbol "val" $> focusVal + , parseFocusAtKey + , parseFocusAtIdx ] parseFocusers :: Parser [Focuser] @@ -115,9 +124,9 @@ rangeRange :: Parser Range rangeRange = label "range" $ do - mstart <- lexeme $ optional integer + mstart <- optional integer symbol ":" - mend <- lexeme $ optional integer + mend <- optional integer return $ RangeRange mstart mend parseFocusSortedBy :: Parser Focuser @@ -166,22 +175,22 @@ parseFocusAdd :: Parser Focuser parseFocusAdd = do symbol "add " - focusTo . mappingAdd <$> scient + focusTo . mappingAdd <$> rational parseFocusSub :: Parser Focuser parseFocusSub = do symbol "sub " - focusTo . mappingSub <$> scient + focusTo . mappingSub <$> rational parseFocusMult :: Parser Focuser parseFocusMult = do symbol "mult " - focusTo . mappingMult <$> scient + focusTo . mappingMult <$> rational parseFocusDiv :: Parser Focuser parseFocusDiv = do symbol "div " - focusTo . mappingDiv <$> scient + focusTo . mappingDiv <$> rational parseFocusPow :: Parser Focuser parseFocusPow = do @@ -191,8 +200,7 @@ parseFocusIf :: Parser Focuser parseFocusIf = do lexeme $ string "if" >> notFollowedBy (satisfy isAlphaNum) - ifExpr <- parseIfExpr - return $ focusIf ifExpr + focusIf <$> parseIfExpr parseIfExpr :: Parser IfExpr parseIfExpr = label "one or more blocks separated by '||'" $ do @@ -269,9 +277,19 @@ parseFocusAverage :: Parser Focuser parseFocusAverage = do symbol "average" - def <- fromMaybe 0 <$> optional scient + def <- fromMaybe 0 <$> optional rational return $ focusAverage def +parseFocusAtKey :: Parser Focuser +parseFocusAtKey = do + symbol "atKey" + focusAtKey <$> stringLiteral + +parseFocusAtIdx :: Parser Focuser +parseFocusAtIdx = do + symbol "atIdx " + focusAtIdx <$> integer + -- mapping parsers parseMapping :: Parser Mapping @@ -311,25 +329,21 @@ parseEvaluatable :: Parser Evaluatable parseEvaluatable = EText <$> stringLiteral <|> - ENumber <$> scient <|> + ENumber <$> rational <|> EFocuser <$> parseFocuser parseEvaluatableLong :: Parser Evaluatable parseEvaluatableLong = EText <$> stringLiteral <|> - ENumber <$> scient <|> + ENumber <$> rational <|> EFocuser . foldFocusers <$> parseFocusers stringLiteral :: Parser Text -stringLiteral = label "string literal" $ lexeme $ do - char '"' - inner <- T.concat <$> many (choice - [ takeWhile1P Nothing (\c -> c /= '/' && c /= '"') - , try (string "\\\"" $> "\"") - , string "\\" +stringLiteral = T.pack <$> label "string literal" (do + between (char '"') (char '"') $ many $ choice + [ char '\\' >> anySingle + , anySingleBut '"' ]) - char '"' - return inner parseMappingAppend :: Parser Mapping parseMappingAppend = do @@ -344,22 +358,22 @@ parseMappingAdd :: Parser Mapping parseMappingAdd = do symbol "add " - mappingAdd <$> scient + mappingAdd <$> rational parseMappingSub :: Parser Mapping parseMappingSub = do symbol "sub " - mappingSub <$> scient + mappingSub <$> rational parseMappingMult :: Parser Mapping parseMappingMult = do symbol "mult " - mappingMult <$> scient + mappingMult <$> rational parseMappingDiv :: Parser Mapping parseMappingDiv = do symbol "div " - mappingDiv <$> scient + mappingDiv <$> rational parseMappingPow :: Parser Mapping parseMappingPow = do diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,14 +1,13 @@ {-# LANGUAGE GADTs #-} module Main where -import Common (safeDiv, showScientific) +import Common (readMaybeRational, showRational) import Data.Char (isAlpha, isAlphaNum, isDigit, isLower, isSpace, isUpper, toLower, toUpper) import Data.Function (on) import Data.List (groupBy, transpose) import Data.List.Extra (dropEnd, groupBy, sort, takeEnd, transpose) -import Data.Maybe (fromMaybe, mapMaybe) -import Data.Scientific (Scientific) +import Data.Maybe (fromMaybe, mapMaybe, fromJust) import qualified Data.Text as T import Focusers (interleave, myWords) import System.IO.Unsafe (unsafePerformIO) @@ -16,7 +15,6 @@ import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) import Text.Read (readMaybe) -import Focusers (readMaybeScientific) main :: IO () main = defaultMain $ testGroup "All" [focuserTests, mappingTests] @@ -74,7 +72,7 @@ ] , testGroup "sortedBy" [ ".sortedBy id.each|get-tree" $= - show (map showScientific $ sort $ map (read :: String -> Scientific) $ filter (all isDigit) $ words input) + show (map showRational $ sort $ map (fromJust . readMaybeRational . T.pack) $ filter (all isDigit) $ words input) , ".sortedBy id.each|over id" $=$ "id|over id" ] , testGroup "sorted" @@ -107,40 +105,40 @@ , "(words.len)|get-tree" $=$ "words.len|get-tree" ] , testGroup "sum" - [ ".sum|get-tree" $= show [showScientific (sum $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ inputNums input)] , "words.sum|get-tree" $= - show (map (showScientific . sum . mapMaybe (readMaybeScientific . T.pack . (:[]))) $ words input) + show (map (showRational . sum . mapMaybe (readMaybeRational . T.pack . (:[]))) $ words input) ] , testGroup "product" - [ ".product|get-tree" $= show [showScientific (product $ inputNums input)] + [ ".product|get-tree" $= show [showRational (product $ inputNums input)] , "words.product|get-tree" $= - show (map (showScientific . product . mapMaybe (readMaybeScientific . T.pack . (:[]))) $ words input) + show (map (showRational . product . mapMaybe (readMaybeRational . T.pack . (:[]))) $ words input) ] , testGroup "average" - [ ".average|get-tree" $= show [showScientific (average $ inputNums input)] + [ ".average|get-tree" $= show [showRational (average $ inputNums input)] , "words.average|get-tree" $= - show (map (showScientific . average . mapMaybe (readMaybeScientific . T.pack . (:[]))) $ words input) + show (map (showRational . average . mapMaybe (readMaybeRational . T.pack . (:[]))) $ words input) ] , testGroup "add" - [ ".sum|get-tree" $= show [showScientific (sum $ map (+1) $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ map (+1) $ inputNums input)] ] , testGroup "sub" - [ ".sum|get-tree" $= show [showScientific (sum $ map (subtract 1) $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ map (subtract 1) $ inputNums input)] ] , testGroup "mult" - [ ".sum|get-tree" $= show [showScientific (sum $ map (*2) $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ map (*2) $ inputNums input)] ] , testGroup "div" - [ ".sum|get-tree" $= show [showScientific (sum $ map (`safeDiv` 2) $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ map (/ 2) $ inputNums input)] ] , testGroup "pow" - [ ".sum|get-tree" $= show [showScientific (sum $ map (^^ 2) $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ map (^^ 2) $ inputNums input)] ] , testGroup "abs" - [ ".sum|get-tree" $= show [showScientific (sum $ map abs $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ map abs $ inputNums input)] ] , testGroup "sign" - [ ".sum|get-tree" $= show [showScientific (sum $ map signum $ inputNums input)] + [ ".sum|get-tree" $= show [showRational (sum $ map signum $ inputNums input)] ] , testGroup "if" [ "words.if 1=1|get-tree" $= show (words input) @@ -198,6 +196,32 @@ ] , testGroup "filter" [ ".filter len<3.each|get-tree" $=$ "words.if len<3|get-tree" ] + , testGroup "regex" + [ "regex \"([a-z]|[A-Z]|[0-9]|_)+\"|get" $=$ "words|get" + , "regex \"([a-z]|[A-Z]|[0-9]|_)+\"|over id" $=$ "id|over id" + ] + , testGroup "json" + [ testGroup "kv" + [ "kv.[0]|get" $$= "\"quiz\"\n" + , "kv.[1].kv.[0]|get" $$= "\"sport\"\n\"maths\"\n" + ] + , testGroup "key" + [ "key|get" $$=$ "kv.key|get" + , "kv.key|get" $$=$ "kv.[0].{1:-1}|get" + ] + , testGroup "val" + [ "val|get" $$=$ "kv.val|get" + , "kv.val|get" $$=$ "kv.[1]|get" + ] + , testGroup "atKey" + [ "atKey \"quiz\"|get" $$=$ "kv.if key=\"quiz\".val|get" + ] + , testGroup "atIdx" + [ "atKey \"quiz\".atKey \"sport\".val.atKey \"options\".atIdx 3|get" $$= "\"Huston Rocket\"\n" + ] + , testGroup "el" + [ "atKey \"quiz\".atKey \"sport\".val.atKey \"options\"..[3]|get" $$= "\"Huston Rocket\"\n" ] + ] ] mappingTests :: TestTree @@ -232,7 +256,7 @@ , testGroup "add/sub/div/pow/abs/sign" [ "id|over add 1" $= mapNums (+ 1) input , "id|over sub 1" $= mapNums (subtract 1) input - , "id|over div 2" $= mapNums (`safeDiv` 2) input + , "id|over div 2" $= mapNums (/ 2) input , "id|over pow 2" $= mapNums (^^ 2) input , "id|over abs" $= mapNums abs input , "id|over sign" $= mapNums signum input @@ -275,23 +299,23 @@ ] allEqual :: (Eq a) => [a] -> Bool -allEqual [] = True +allEqual [] = True allEqual (x:xs) = all (== x) xs anyEqual :: (Eq a) => [a] -> Bool -anyEqual [] = False +anyEqual [] = False anyEqual (x:xs) = x `elem` xs || anyEqual xs -mapNums :: (Scientific -> Scientific) -> String -> String +mapNums :: (Rational -> Rational) -> String -> String mapNums f str = let (ws, words) = myWords $ T.pack str new_words = map (mapNum f . T.unpack) words in T.unpack $ T.concat $ interleave ws words where - mapNum :: (Scientific -> Scientific) -> String -> String + mapNum :: (Rational -> Rational) -> String -> String mapNum f str = case readMaybe str of Nothing -> str - Just n -> T.unpack $ showScientific $ f n + Just n -> T.unpack $ showRational $ f n getWS :: String -> [String] getWS str = @@ -301,17 +325,21 @@ getCols :: String -> [[String]] getCols = transpose . map words . lines -inputNums :: String -> [Scientific] -inputNums str = mapMaybe readMaybe $ words str +inputNums :: String -> [Rational] +inputNums str = mapMaybe (readMaybeRational . T.pack) $ words str -average :: [Scientific] -> Scientific +average :: [Rational] -> Rational average [] = 0 -average ns = sum ns `safeDiv` fromIntegral (length ns) +average ns = sum ns / fromIntegral (length ns) {-# NOINLINE input #-} input :: String input = unsafePerformIO $ readFile "test/input.txt" +{-# NOINLINE json #-} +json :: String +json = unsafePerformIO $ readFile "test/input.json" + infixl 1 $= ($=) :: String -> String -> TestTree ($=) command desiredOutput = testCase command $ do @@ -323,5 +351,19 @@ ($=$) cmd1 cmd2 = testCase (cmd1 ++ " == " ++ cmd2) $ do out1 <- readProcess "./smh" [cmd1] input out2 <- readProcess "./smh" [cmd2] input + out1 @?= out2 + +-- This is stupid, but whatever +infixl 1 $$= +($$=) :: String -> String -> TestTree +($$=) command desiredOutput = testCase command $ do + output <- readProcess "./smh" [command] json + output @?= desiredOutput + +infixl 1 $$=$ +($$=$) :: String -> String -> TestTree +($$=$) cmd1 cmd2 = testCase (cmd1 ++ " == " ++ cmd2) $ do + out1 <- readProcess "./smh" [cmd1] json + out2 <- readProcess "./smh" [cmd2] json out1 @?= out2