edits (empty) → 0.1.0.0

raw patch · 14 files changed

+643/−0 lines, 14 filesdep +basedep +containersdep +editssetup-changed

Dependencies added: base, containers, edits, hedgehog, matrix, primitive, protolude, registry-hedgehog, tasty, tasty-discover, tasty-hedgehog, text, vector

Files

• LICENSE.txt +16/−0
• Setup.hs +4/−0
• edits.cabal +86/−0
• src/Data/Text/Costs.hs +63/−0
• src/Data/Text/Difference.hs +77/−0
• src/Data/Text/EditMatrix.hs +105/−0
• src/Data/Text/EditOperation.hs +21/−0
• src/Data/Text/Edits.hs +99/−0
• src/Data/Text/Shorten.hs +93/−0
• src/Data/Text/Token.hs +25/−0
• test/AutoDiscoveredSpecs.hs +1/−0
• test/Test/Data/Text/EditsSpec.hs +13/−0
• test/Test/Data/Text/ShortenSpec.hs +35/−0
• test/test.hs +5/−0

@@ -0,0 +1,16 @@+Copyright (c) 2022 Eric Torreborre <etorreborre@yahoo.com>++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.

@@ -0,0 +1,4 @@+import Distribution.Simple++main :: IO ()+main = defaultMain

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

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

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

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

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

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

@@ -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 -- <start>abcdefgh -> ...defgh++            if head cur == Just Start+              then res <> shortenLeft shortenOptions cur+              else -- abcdefgh<end> -> 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

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

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=AutoDiscoveredSpecs #-}

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

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

@@ -0,0 +1,5 @@+import AutoDiscoveredSpecs (tests)+import Protolude+import Test.Tasty.Hedgehogx++main = tests >>= defaultMain . groupByModuleName