smh 0.1.3.1 → 0.2.0

raw patch · 7 files changed

+384/−146 lines, 7 filesdep −scientificPVP ok

version bump matches the API change (PVP)

Dependencies removed: scientific

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−1
• smh.cabal +8/−10
• src/Common.hs +28/−13
• src/Focusers.hs +204/−44
• src/Mappings.hs +12/−13
• src/Parsers.hs +51/−37
• test/Main.hs +70/−28

@@ -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 \")

@@ -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 

@@ -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

@@ -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

@@ -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 (^^)

@@ -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

@@ -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"         [ "<words.if isDigit>.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)         , "<words.if isAlpha>.sortedBy id.each|over id" $=$ "id|over id"         ]     , testGroup "sorted"@@ -107,40 +105,40 @@         , "(words.len)|get-tree" $=$ "words.len|get-tree"         ]     , testGroup "sum"-        [ "<words>.sum|get-tree" $= show [showScientific (sum $ inputNums input)]+        [ "<words>.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"-        [ "<words>.product|get-tree" $= show [showScientific (product $ inputNums input)]+        [ "<words>.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"-        [ "<words>.average|get-tree" $= show [showScientific (average $ inputNums input)]+        [ "<words>.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"-        [ "<words.add 1>.sum|get-tree" $= show [showScientific (sum $ map (+1) $ inputNums input)]+        [ "<words.add 1>.sum|get-tree" $= show [showRational (sum $ map (+1) $ inputNums input)]         ]     , testGroup "sub"-        [ "<words.sub 1>.sum|get-tree" $= show [showScientific (sum $ map (subtract 1) $ inputNums input)]+        [ "<words.sub 1>.sum|get-tree" $= show [showRational (sum $ map (subtract 1) $ inputNums input)]         ]     , testGroup "mult"-        [ "<words.mult 2>.sum|get-tree" $= show [showScientific (sum $ map (*2) $ inputNums input)]+        [ "<words.mult 2>.sum|get-tree" $= show [showRational (sum $ map (*2) $ inputNums input)]         ]     , testGroup "div"-        [ "<words.div 2>.sum|get-tree" $= show [showScientific (sum $ map (`safeDiv` 2) $ inputNums input)]+        [ "<words.div 2>.sum|get-tree" $= show [showRational (sum $ map (/ 2) $ inputNums input)]         ]     , testGroup "pow"-        [ "<words.pow 2>.sum|get-tree" $= show [showScientific (sum $ map (^^ 2) $ inputNums input)]+        [ "<words.pow 2>.sum|get-tree" $= show [showRational (sum $ map (^^ 2) $ inputNums input)]         ]     , testGroup "abs"-        [ "<words.abs>.sum|get-tree" $= show [showScientific (sum $ map abs $ inputNums input)]+        [ "<words.abs>.sum|get-tree" $= show [showRational (sum $ map abs $ inputNums input)]         ]     , testGroup "sign"-        [ "<words.sign>.sum|get-tree" $= show [showScientific (sum $ map signum $ inputNums input)]+        [ "<words.sign>.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"         [ "<words>.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\".<el>.[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