diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,16 @@ +Copyright (c) 2022 Eric Torreborre + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated +documentation files (the "Software"), to deal in the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, +and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of +the Software. Neither the name of specs nor the names of its contributors may be used to endorse or promote +products derived from this software without specific prior written permission. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED +TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF +CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/edits.cabal b/edits.cabal new file mode 100644 --- /dev/null +++ b/edits.cabal @@ -0,0 +1,86 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.0. +-- +-- see: https://github.com/sol/hpack + +name: edits +version: 0.1.0.0 +synopsis: compute the distance between 2 strings as a list of edit operations +description: This library returns the minimum number of edit operations 'add', 'remove' necessary to transform a string into another. It also provides ways to display the difference between the strings +category: Control +maintainer: etorreborre@yahoo.com +license: MIT +license-file: LICENSE.txt +build-type: Simple + +source-repository head + type: git + location: https://github.com/etorreborre/edits + +library + exposed-modules: + Data.Text.Costs + Data.Text.Difference + Data.Text.EditMatrix + Data.Text.EditOperation + Data.Text.Edits + Data.Text.Shorten + Data.Text.Token + other-modules: + Paths_edits + hs-source-dirs: + src + default-extensions: + LambdaCase + MultiWayIf + NoImplicitPrelude + OverloadedStrings + TypeFamilies + TypeFamilyDependencies + TypeOperators + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -fhide-source-paths -fprint-potential-instances -fno-warn-partial-type-signatures -optP-Wno-nonportable-include-path -Wincomplete-uni-patterns + build-depends: + base >=4.14 && <5 + , containers >=0.2 && <1 + , matrix >=0.3 && <1 + , primitive >=0.6 && <1 + , protolude ==0.3.* + , text ==1.* + , vector >=0.10 && <2 + default-language: GHC2021 + +test-suite spec + type: exitcode-stdio-1.0 + main-is: test.hs + other-modules: + AutoDiscoveredSpecs + Test.Data.Text.EditsSpec + Test.Data.Text.ShortenSpec + Paths_edits + hs-source-dirs: + test + default-extensions: + LambdaCase + MultiWayIf + NoImplicitPrelude + OverloadedStrings + TypeFamilies + TypeFamilyDependencies + TypeOperators + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -fhide-source-paths -fprint-potential-instances -fno-warn-partial-type-signatures -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N -fno-warn-orphans -fno-warn-missing-signatures -fno-warn-incomplete-uni-patterns -fno-warn-type-defaults -optP-Wno-nonportable-include-path + build-depends: + base >=4.14 && <5 + , containers >=0.2 && <1 + , edits + , hedgehog >=1.0 && <2 + , matrix >=0.3 && <1 + , primitive >=0.6 && <1 + , protolude ==0.3.* + , registry-hedgehog >=0.7 && <1 + , tasty ==1.* + , tasty-discover >=2 && <5 + , tasty-hedgehog >=1.0 && <2.0 + , text ==1.* + , vector >=0.10 && <2 + default-language: GHC2021 diff --git a/src/Data/Text/Costs.hs b/src/Data/Text/Costs.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Costs.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE RecordWildCards #-} + +-- | This module supports a general definition of costs for performing edit operations +-- on 2 lists of elements +module Data.Text.Costs where + +import Protolude + +-- | Current operation in a cost matrix and current cost +data Cost + = Insertion Int + | Deletion Int + | Substitution Int + | NoAction Int + deriving (Eq, Show) + +-- | Return the cost of an operation +cost :: Cost -> Int +cost (Insertion c) = c +cost (Deletion c) = c +cost (Substitution c) = c +cost (NoAction c) = c + +-- | Nicer display for a cost +showCost :: Cost -> Text +showCost (Insertion c) = "+ " <> show c +showCost (Deletion c) = "- " <> show c +showCost (Substitution c) = "~ " <> show c +showCost (NoAction c) = "o " <> show c + +-- | This component contains functions to evaluate the cost of +-- substituting, inserting, deleting an element +data Costs a = Costs + { substitutionCost :: a -> a -> Int, + insertionCost :: a -> Int, + deletionCost :: a -> Int, + lowerCost :: a -> a -> Int -> Int -> Int -> Cost + } + +-- | Classic costs for the Levenshtein distance +-- applied to characters in a piece of Text +textLevenshteinCosts :: Costs Char +textLevenshteinCosts = levenshteinCosts @Char + +-- | Classic costs for the Levenshtein distance +levenshteinCosts :: forall a. (Eq a) => Costs a +levenshteinCosts = Costs {..} + where + substitutionCost :: a -> a -> Int + substitutionCost a1 a2 = if a1 == a2 then 0 else 1 + + insertionCost :: a -> Int + insertionCost = const 1 + + deletionCost :: a -> Int + deletionCost = const 1 + + lowerCost :: a -> a -> Int -> Int -> Int -> Cost + lowerCost a1 a2 del subst ins = do + let (opDel, opSubst, opIns) = (Deletion del, Substitution subst, Insertion ins) + if ins < del + then (if (ins < subst) || (ins == subst && a1 == a2) then opIns else opSubst) + else (if (del < subst) || (del == subst && a1 == a2) then opDel else opSubst) diff --git a/src/Data/Text/Difference.hs b/src/Data/Text/Difference.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Difference.hs @@ -0,0 +1,77 @@ +-- | This module provides data types and functions to display +-- the difference between 2 strings according to the number of edit operations +-- necessary to go from one to the other +module Data.Text.Difference where + +import Data.Text qualified as T +import Data.Text.EditOperation +import Data.Text.Shorten +import Data.Text.Token +import Protolude + +-- | Separators are used to highlight a difference between 2 pieces of text +-- for example +data Separators = Separators + { startSeparator :: Text, + endSeparator :: Text + } + deriving (Eq, Show) + +-- | Make parens separators +parensSeparators :: Separators +parensSeparators = makeCharSeparators '(' ')' + +-- | Make brackets separators +bracketsSeparators :: Separators +bracketsSeparators = makeCharSeparators '[' ']' + +-- | Make separators with simple Chars +makeCharSeparators :: Char -> Char -> Separators +makeCharSeparators c1 c2 = Separators (T.singleton c1) (T.singleton c2) + +-- | Options to use for displaying differences +data DisplayOptions = DisplayOptions + { _separators :: Separators, + _shortenOptions :: ShortenOptions, + _displayEditOperation :: EditOperation Char -> Text + } + +-- | Default display options +defaultDisplayOptions :: DisplayOptions +defaultDisplayOptions = DisplayOptions bracketsSeparators (ShortenOptions 20 "...") defaultDisplayEditOperations + +-- | Default display for edit operations +defaultDisplayEditOperations :: EditOperation Char -> Text +defaultDisplayEditOperations (Insert c) = T.singleton c +defaultDisplayEditOperations (Delete c) = T.singleton c +defaultDisplayEditOperations (Substitute c _) = T.singleton c +defaultDisplayEditOperations (Keep c) = T.singleton c + +-- | Display an edit operation by prepending a symbol showing which operation is used +taggedDisplayEditOperation :: EditOperation Char -> Text +taggedDisplayEditOperation (Insert c) = "+" <> T.singleton c +taggedDisplayEditOperation (Delete c) = "-" <> T.singleton c +taggedDisplayEditOperation (Substitute c1 c2) = "~" <> T.singleton c1 <> "/" <> T.singleton c2 +taggedDisplayEditOperation (Keep c) = T.singleton c + +-- | Show the differences by enclosing them in separators +-- Additionally shorten the text outside the separators if it is too long +displayDiffs :: DisplayOptions -> [EditOperation Char] -> Text +displayDiffs (DisplayOptions (Separators start end) shortenOptions displayEditOperation) operations = do + let (isDifferent, result) = + foldl' + ( \(different, res) operation -> + -- different keeps track of the fact that we entered a section of the text having some differences + -- this allows us to open a 'start' delimiter + -- then when we go back to keeping the same character, we can close with an 'end' delimiter + case operation of + Insert {} -> (True, res <> [Delimiter start | not different]) + Delete {} -> (True, res <> [Delimiter start | not different] <> [Kept $ displayEditOperation operation]) + Substitute {} -> (True, res <> [Delimiter start | not different] <> [Kept $ displayEditOperation operation]) + Keep {} -> (False, res <> [Delimiter end | different] <> [Kept $ displayEditOperation operation]) + ) + (False, []) + operations + + let fullResult = if isDifferent then result <> [Delimiter end] else result + T.concat (showToken <$> shortenTokens shortenOptions (Delimiter start) (Delimiter end) fullResult) diff --git a/src/Data/Text/EditMatrix.hs b/src/Data/Text/EditMatrix.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/EditMatrix.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE OverloadedLists #-} + +-- | This module computes a matrix keeping track of the costs necessary +-- to edit one piece of text so that it is transformed into another one +-- From that matrix it is possible to extract the sequence of edit operations with the minimum cost +module Data.Text.EditMatrix where + +import Data.Matrix hiding (matrix, (!), getElem, setElem) +import Data.Matrix qualified as M +import Data.Text.Costs +import Data.Text.EditOperation +import Data.Vector as V (Vector, cons, fromList, head, take, (!)) +import Protolude + +-- | Create a edit matrix where costs are computed using dynamic programming +createEditMatrix :: Costs a -> [a] -> [a] -> Matrix Cost +createEditMatrix costs as1 as2 = do + let initialMatrix = M.matrix (length as1 + 1) (length as2 + 1) (const $ NoAction 0) + let coordinates = cartesian (length as1) (length as2) + foldl' + ( \ma (i, j) -> + let newCost + | i == 0 = Insertion j -- no more letters for as1, we do j insertions + | j == 0 = Deletion i -- no more letters for as2, we do i suppressions + | otherwise = costOf i j ma -- otherwise we compute the cost and operation to go from as1[i] to as2[j] + in setElement newCost i j ma + ) + initialMatrix + coordinates + where + (vs1, vs2) = (V.fromList as1, V.fromList as2) + + -- compute the cartesian product of the [0..i] x [0..j] lists + cartesian :: Int -> Int -> [(Int, Int)] + cartesian m n = [(i, j) | i <- [0 .. m], j <- [0 .. n]] + + -- compute the cost of going from as1[i] to as2[j], knowing the existing costs + -- (i-1, j-1) (i-1, j) + -- (i, j-1) (i, j) + -- + -- going from (i-1, j) to (i, j) means that we delete as1[i] + -- going from (i-1, j-1) to (i, j) means that we substitute as1[i] with as2[j] + -- going from (i, j-1) to (i, j) means that we insert as2[j] + costOf :: Int -> Int -> Matrix Cost -> Cost + costOf i j matrix = do + let i1 = i - 1 + let j1 = j - 1 + let i1j = getElement i1 j matrix + let i1j1 = getElement i1 j1 matrix + let ij1 = getElement i j1 matrix + let result = + lowerCost + costs + (vs1 ! i1) + (vs2 ! j1) + (cost i1j + deletionCost costs (vs1 ! i1)) -- suppression + (cost i1j1 + substitutionCost costs (vs1 ! i1) (vs2 ! j1)) -- substitution + (cost ij1 + insertionCost costs (vs2 ! j1)) -- insertion + -- in case of a substitution if the resulting cost of (i, j) is the same as (i-1, j-1) + -- this means that we have substituted the same letter and it is the same as doing no action + case result of + Substitution {} | cost i1j1 == cost result -> NoAction (cost result) + _ -> result + +-- | From the original lists of characters, given the cost matrix +-- return a list of edit operations allowing to edit one text and eventually get the second one +makeEditOperations :: forall a. Vector a -> Vector a -> Matrix Cost -> Vector (EditOperation a) +makeEditOperations [] _ _ = [] +makeEditOperations _ [] _ = [] +makeEditOperations as1 as2 matrix = + go (length as1) (length as2) [] + where + go :: Int -> Int -> Vector (EditOperation a) -> Vector (EditOperation a) + go 0 0 _ = [] + go i j ops = do + let op = getElement i j matrix + let dist = cost op + if i == 1 && j == 1 + then + if dist == 0 + then V.cons (Keep (V.head as1)) ops + else V.cons (Substitute (V.head as1) (V.head as2)) ops + else + if j < 0 + then fmap Delete (V.take i as1) <> ops + else + if i < 0 + then fmap Insert (V.take j as2) <> ops + else case op of + Insertion {} -> go i (j - 1) (V.cons (Insert (as2 ! (j - 1))) ops) + Deletion {} -> go (i - 1) j (V.cons (Delete (as1 ! (i - 1))) ops) + Substitution {} -> go (i - 1) (j - 1) (V.cons (Substitute (as1 ! (i - 1)) (as2 ! (j - 1))) ops) + _ -> go (i - 1) (j - 1) (V.cons (Keep (as1 ! (i - 1))) ops) + +-- | Return the element at position i, j in the matrix +-- A matrix in the matrix package is 1-indexed but all the computations in this module are 0-indexed +-- so we need to shift the indices +getElement :: Int -> Int -> Matrix a -> a +getElement i j = M.getElem (i + 1) (j + 1) + +-- | Set the element at position i, j in the matrix +-- A matrix in the matrix package is 1-indexed but all the computations in this module are 0-indexed +-- so we need to shift the indices +setElement :: a -> Int -> Int -> Matrix a -> Matrix a +setElement a i j = M.setElem a (i + 1, j + 1) diff --git a/src/Data/Text/EditOperation.hs b/src/Data/Text/EditOperation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/EditOperation.hs @@ -0,0 +1,21 @@ +-- | Data type describing the operation of editing some text +module Data.Text.EditOperation where + +import Protolude + +-- | Atomic operation required to edit a piece of text +-- at a given position in the EditMatrix +data EditOperation a + = Insert a + | Delete a + | Substitute a a + | Keep a + deriving (Eq, Show) + +-- | Inverse of an edit operation. It is used +-- to display not only how to go from text1 to text2 but also from text2 to text1 +inverse :: EditOperation a -> EditOperation a +inverse (Insert a) = Delete a +inverse (Delete a) = Insert a +inverse (Substitute a1 a2) = Substitute a2 a1 +inverse (Keep a) = Keep a diff --git a/src/Data/Text/Edits.hs b/src/Data/Text/Edits.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Edits.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedLists #-} + +{- | + This module provides a 'showDistance' function showing the differences between 2 pieces of text + using the Levenshtein distance. That distance is defined as the minimum number of edits: insertions, deletions, substitutions + to go from one text to another. + + Several options are available to customize this processing: + - split size: texts are broken into new lines first. Then if the texts are too large there are split into smaller pieces + in order to compute their difference. This is done in order to reduce the size of the edit matrix which is used to compute all the edit costs + the default is 200 + + - separators: opening and closing pieces of text (brackets by default) used to highlight a difference + + - shorten size: there is the possibly to display mostly the differences with a bit of context around if the input text is too large. + The text gets elided around separators if it gets greater than the shorten size (the default is 20) + + - shorten text: the text to use when eliding characters in the original text (the default is "...") + + - display edit operations: edit operations, insert/delete/substitute/keep can be annotated if necessary + +Here are some examples: + +@ +import Data.Text.Edits + +-- "between the e and the n the letter i was added" +showDistance "kitten" "kittein" === ("kitte[]n", "kitte[i]n") + +-- "at the end of the text 3 letters have been deleted" +showDistance "kitten" "kit" === ("kit[ten]", "kit[]") + +-- "between the t and the n 2 letters have been modified" +showDistance "kitten" "kitsin" === ("kit[te]n", "kit[si]n" ) +@ + +-} +module Data.Text.Edits + ( SplitSize (..), + ShortenOptions (..), + Separators (..), + DisplayOptions (..), + EditOperation (..), + showDistance, + defaultDisplayOptions, + defaultDisplayEditOperations, + taggedDisplayEditOperation, + defaultSplitSize, + parensSeparators, + bracketsSeparators, + makeCharSeparators, + ) +where + +import Data.Text qualified as T +import Data.Text.Costs +import Data.Text.Difference +import Data.Text.EditMatrix +import Data.Text.EditOperation +import Data.Text.Shorten +import Data.Vector qualified as V +import Protolude + +-- | Size to use when splitting a large piece of text +newtype SplitSize = SplitSize Int deriving (Eq, Show) + +-- | Default split size +defaultSplitSize :: SplitSize +defaultSplitSize = SplitSize 200 + +-- | Show the distance between 2 pieces of text +showDistance :: Text -> Text -> (Text, Text) +showDistance = showDistanceWith defaultSplitSize defaultDisplayOptions + +-- | Show the distance between 2 pieces of text and specify splitting / display options +showDistanceWith :: SplitSize -> DisplayOptions -> Text -> Text -> (Text, Text) +showDistanceWith splitSize displayOptions ts1 ts2 = + foldSplitTexts splitSize ts1 ts2 ([], []) $ \ts (line1, line2) -> do + let matrix = createEditMatrix textLevenshteinCosts (toS line1) (toS line2) + let operations = toList $ makeEditOperations (V.fromList . toS $ line1) (V.fromList . toS $ line2) matrix + ts <> (displayDiffs displayOptions operations, displayDiffs displayOptions $ inverse <$> operations) + +-- | Split texts and apply the difference on each part +foldSplitTexts :: SplitSize -> Text -> Text -> a -> (a -> (Text, Text) -> a) -> a +foldSplitTexts splitSize t1 t2 initial f = do + let (s1, s2) = (split splitSize t1, split splitSize t2) + foldl' f initial (zip s1 s2) + +-- | Split a text on newlines then split each line on a maximum split size +-- We then perform the edit distance algorithm on smaller sizes of text in order to control memory and CPU +split :: SplitSize -> Text -> [Text] +split splitSize = concatMap (splitToSize splitSize) . T.splitOn "\n" + +-- | Split a text on a maximum split size +splitToSize :: SplitSize -> Text -> [Text] +splitToSize ss@(SplitSize n) t = + if T.length t <= n + then [t] + else T.take n t : splitToSize ss (T.drop n t) diff --git a/src/Data/Text/Shorten.hs b/src/Data/Text/Shorten.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Shorten.hs @@ -0,0 +1,93 @@ +-- | This module provides functions to shorten a piece of text +-- where parts of the text are delimited to highlight the difference with another piece of text +-- Then only the parts outside the difference are being shortened +module Data.Text.Shorten where + +import Data.Coerce +import Data.Text qualified as T +import Data.Text.Token +import Protolude + +-- | Size used to decide if a piece of text needs to be shortened +data ShortenOptions = ShortenOptions + { _shortenSize :: Int, + _shortenText :: Text + } + deriving (Eq, Show) + +-- | Cut the shorten size in 2 +half :: ShortenOptions -> ShortenOptions +half (ShortenOptions ss t) = ShortenOptions (coerce ss `div` 2) t + +-- | Shorten a piece of text that has already been tokenized +shortenTokens :: ShortenOptions -> Token -> Token -> [Token] -> [Token] +shortenTokens shortenOptions startDelimiter endDelimiter tokens = do + foldl' + ( \res cur -> + -- [abcdefgh] -> [abcdefgh] + if head cur == Just startDelimiter && lastMay cur == Just endDelimiter + then res <> cur + else -- abcdefgh -> ...defgh + + if head cur == Just Start + then res <> shortenLeft shortenOptions cur + else -- abcdefgh -> abcd... + + if lastMay cur == Just End + then res ++ shortenRight shortenOptions cur + else -- abcdefgh -> abc...fgh + res <> shortenCenter shortenOptions cur + ) + [] + delimitedTokens + where + delimitedTokens = splitOnDelimiters startDelimiter endDelimiter (Start : (tokens <> [End])) + +-- | Split a list of tokens into several lists when a delimiter is found +-- abcd[efgh]ijkl[mnop]qrst -> [abcd, [efgh], ijkl, [mnop], qrst] +splitOnDelimiters :: Token -> Token -> [Token] -> [[Token]] +splitOnDelimiters start end = + foldl' + ( \res cur -> + if cur == start + then res <> [[start]] + else + if cur == end + then updateLast res (<> [end]) + else case lastMay res of + Just ts -> + if lastMay ts == Just end + then res <> [[cur]] + else updateLast res (<> [cur]) + _ -> + [[cur]] + ) + ([] :: [[Token]]) + +-- | Shorten some token on the left: ...tokens +shortenLeft :: ShortenOptions -> [Token] -> [Token] +shortenLeft so ts = whenTooLong so ts $ Kept (_shortenText so) : drop (length ts - _shortenSize so) ts + +-- | Shorten some token on the right: tokens... +shortenRight :: ShortenOptions -> [Token] -> [Token] +shortenRight so ts = whenTooLong so ts $ take (_shortenSize so) ts <> [Kept $ _shortenText so] + +-- | Shorten some token in the center: ...tokens... +shortenCenter :: ShortenOptions -> [Token] -> [Token] +shortenCenter so ts = whenTooLong so ts $ take (_shortenSize $ half so) ts <> [Kept $ _shortenText so] <> drop (length ts - _shortenSize so `div` 2) ts + +-- | Depending on the shorten option and the original list of tokens used a shorter version +whenTooLong :: ShortenOptions -> [Token] -> [Token] -> [Token] +whenTooLong so original shortened = + if tokenSize original > _shortenSize so then shortened else original + where + tokenSize :: [Token] -> Int + tokenSize = sum . fmap (\case Kept value -> T.length value; _ -> 0) + +-- * Helpers + +-- | Update the last element of a list +updateLast :: [a] -> (a -> a) -> [a] +updateLast [] _ = [] +updateLast [a] f = [f a] +updateLast (a : as) f = a : updateLast as f diff --git a/src/Data/Text/Token.hs b/src/Data/Text/Token.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Token.hs @@ -0,0 +1,25 @@ +-- | This module helps parsing some text with delimited differences +module Data.Text.Token where + +import Protolude +import Data.Text qualified as T + +-- | A Token is used to enclose a piece of text to compare and delimiters showing where the text is different from another piece of text +-- Start / End are markers for the beginning and end of that text +data Token + = Kept Text + | Delimiter Text + | Start + | End + deriving (Eq, Show) + +-- | Show a Token by skipping Start/End if present +showToken :: Token -> Text +showToken (Kept t) = t +showToken (Delimiter t) = t +showToken Start = "" +showToken End = "" + +-- | Show a list of tokens. Start/End are skipped +showTokens :: [Token] -> Text +showTokens = T.concat . fmap showToken diff --git a/test/AutoDiscoveredSpecs.hs b/test/AutoDiscoveredSpecs.hs new file mode 100644 --- /dev/null +++ b/test/AutoDiscoveredSpecs.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=AutoDiscoveredSpecs #-} diff --git a/test/Test/Data/Text/EditsSpec.hs b/test/Test/Data/Text/EditsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Text/EditsSpec.hs @@ -0,0 +1,13 @@ +module Test.Data.Text.EditsSpec where + +import Data.Text.Edits +import Protolude +import Test.Tasty.Hedgehogx + +test_show_distance = test "show the distance between different strings" $ do + showDistance "kitte" "kittei" === ("kitte[]", "kitte[i]") + showDistance "kitten" "kittein" === ("kitte[]n", "kitte[i]n") + showDistance "kitten" "kit" === ("kit[ten]", "kit[]") + showDistance "kit" "kitten" === ("kit[]", "kit[ten]") + showDistance "kitten" "kitsin" === ("kit[te]n", "kit[si]n") + showDistance "kitte" "kitte" === ("kitte", "kitte") diff --git a/test/Test/Data/Text/ShortenSpec.hs b/test/Test/Data/Text/ShortenSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Text/ShortenSpec.hs @@ -0,0 +1,35 @@ +module Test.Data.Text.ShortenSpec where + +import Data.Text qualified as T +import Data.Text.Shorten +import Data.Text.Token +import Protolude +import Test.Tasty.Hedgehogx + +test_shorten = test "shorten difference" $ do + shorten "abcd" === "abcd" + shorten "abcdefghijkl[mn]opqr" === "...hijkl[mn]opqr" + shorten "abcdefghijkl[mn]" === "...hijkl[mn]" + shorten "[mn]abcdefghijkl" === "[mn]abcde..." + shorten "abcdefghijkl[mn]opqrstuv" === "...hijkl[mn]opqrs..." + shorten "hijkl[zz]abcdefghijklmno[xx]abcde" === "hijkl[zz]ab...no[xx]abcde" + shorten "hijkl[]xxabcdefghijklmno[]xxabcde" === "hijkl[]xx...no[]xxabc..." + shorten "abcdef[]ghijkl" === "...bcdef[]ghijk..." + shorten "abcdefg[zz]abcdefghijklmno[xx]abcdefg" === "...cdefg[zz]ab...no[xx]abcde..." + +-- * Helpers + +shorten :: Text -> Text +shorten t = do + let tokens = + toS t <&> \(c :: Char) -> + if c == '[' + then Delimiter "[" + else + if c == ']' + then Delimiter "]" + else Kept (T.singleton c) + + showTokens $ shortenTokens shortenOptions (Delimiter "[") (Delimiter "]") tokens + where + shortenOptions = ShortenOptions 5 "..." diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -0,0 +1,5 @@ +import AutoDiscoveredSpecs (tests) +import Protolude +import Test.Tasty.Hedgehogx + +main = tests >>= defaultMain . groupByModuleName