Compare commits
21 Commits
stable
...
pdavidow-s
Author | SHA1 | Date | |
---|---|---|---|
|
ef02b27bca | ||
|
7c73a44a51 | ||
|
b3e9c7f7dc | ||
|
5c0d162a1a | ||
|
1df330d3c5 | ||
|
3e182dbca5 | ||
|
ea8f1ee9a4 | ||
|
c6db756b68 | ||
|
faf09acf65 | ||
|
d005d79d54 | ||
|
12a1b083c0 | ||
|
0ce77987e3 | ||
|
62b3044001 | ||
|
827bff3cb4 | ||
|
f859696b05 | ||
|
67bac7c7f9 | ||
|
bd4077f04c | ||
|
a9048e7270 | ||
|
bb8a9f4b1e | ||
|
4d99921bde | ||
|
32a0e6359c |
@ -32,6 +32,7 @@ dependencies:
|
||||
- http-types == 0.12.*
|
||||
- memory == 0.18.*
|
||||
- mtl == 2.3.*
|
||||
- myers-diff >= 0.2.0.0
|
||||
- network >= 3.1.2.7 && < 3.2
|
||||
- optparse-applicative >= 0.15 && < 0.17
|
||||
- process == 1.6.*
|
||||
|
@ -34,6 +34,7 @@ library
|
||||
Simplex.Chat.Core
|
||||
Simplex.Chat.Help
|
||||
Simplex.Chat.Markdown
|
||||
Simplex.Chat.MarkdownDiff
|
||||
Simplex.Chat.Messages
|
||||
Simplex.Chat.Messages.CIContent
|
||||
Simplex.Chat.Migrations.M20220101_initial
|
||||
@ -165,6 +166,7 @@ library
|
||||
, http-types ==0.12.*
|
||||
, memory ==0.18.*
|
||||
, mtl ==2.3.*
|
||||
, myers-diff >= 0.2.0.0
|
||||
, network >=3.1.2.7 && <3.2
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, process ==1.6.*
|
||||
@ -213,6 +215,7 @@ executable simplex-bot
|
||||
, http-types ==0.12.*
|
||||
, memory ==0.18.*
|
||||
, mtl ==2.3.*
|
||||
, myers-diff >= 0.2.0.0
|
||||
, network >=3.1.2.7 && <3.2
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, process ==1.6.*
|
||||
@ -262,6 +265,7 @@ executable simplex-bot-advanced
|
||||
, http-types ==0.12.*
|
||||
, memory ==0.18.*
|
||||
, mtl ==2.3.*
|
||||
, myers-diff >= 0.2.0.0
|
||||
, network >=3.1.2.7 && <3.2
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, process ==1.6.*
|
||||
@ -313,6 +317,7 @@ executable simplex-broadcast-bot
|
||||
, http-types ==0.12.*
|
||||
, memory ==0.18.*
|
||||
, mtl ==2.3.*
|
||||
, myers-diff >= 0.2.0.0
|
||||
, network >=3.1.2.7 && <3.2
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, process ==1.6.*
|
||||
@ -363,6 +368,7 @@ executable simplex-chat
|
||||
, http-types ==0.12.*
|
||||
, memory ==0.18.*
|
||||
, mtl ==2.3.*
|
||||
, myers-diff >= 0.2.0.0
|
||||
, network ==3.1.*
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, process ==1.6.*
|
||||
@ -453,6 +459,7 @@ test-suite simplex-chat-test
|
||||
ChatTests.Profiles
|
||||
ChatTests.Utils
|
||||
MarkdownTests
|
||||
MarkdownDiffTests
|
||||
MobileTests
|
||||
ProtocolTests
|
||||
SchemaDump
|
||||
@ -492,6 +499,7 @@ test-suite simplex-chat-test
|
||||
, http-types ==0.12.*
|
||||
, memory ==0.18.*
|
||||
, mtl ==2.3.*
|
||||
, myers-diff >= 0.2.0.0
|
||||
, network ==3.1.*
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, process ==1.6.*
|
||||
|
@ -17,7 +17,7 @@ import qualified Data.Attoparsec.Text as A
|
||||
import Data.Char (isDigit)
|
||||
import Data.Either (fromRight)
|
||||
import Data.Functor (($>))
|
||||
import Data.List (intercalate, foldl')
|
||||
import Data.List (foldl', intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe, isNothing)
|
||||
@ -51,8 +51,16 @@ data Format
|
||||
| SimplexLink {linkType :: SimplexLinkType, simplexUri :: Text, trustedUri :: Bool, smpHosts :: NonEmpty Text}
|
||||
| Email
|
||||
| Phone
|
||||
| Edited EditAction Format
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
data EditAction = EAInsert | EADelete | EAChangeFormat
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON EditAction where
|
||||
toJSON = J.genericToJSON . enumJSON $ dropPrefix "EA"
|
||||
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "EA"
|
||||
|
||||
data SimplexLinkType = XLContact | XLInvitation | XLGroup
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
@ -129,7 +137,7 @@ parseMaybeMarkdownList s
|
||||
| otherwise = Just . reverse $ foldl' acc [] ml
|
||||
where
|
||||
ml = intercalate ["\n"] . map (markdownToList . parseMarkdown) $ T.lines s
|
||||
acc [] m = [m]
|
||||
acc [] m = [m]
|
||||
acc ms@(FormattedText f t : ms') ft@(FormattedText f' t')
|
||||
| f == f' = FormattedText f (t <> t') : ms'
|
||||
| otherwise = ft : ms
|
||||
@ -170,14 +178,14 @@ markdownP = mconcat <$> A.many' fragmentP
|
||||
md :: Char -> Format -> Text -> Markdown
|
||||
md c f s
|
||||
| T.null s || T.head s == ' ' || T.last s == ' ' =
|
||||
unmarked $ c `T.cons` s `T.snoc` c
|
||||
unmarked $ c `T.cons` s `T.snoc` c
|
||||
| otherwise = markdown f s
|
||||
secretP :: Parser Markdown
|
||||
secretP = secret <$> A.takeWhile (== '#') <*> A.takeTill (== '#') <*> A.takeWhile (== '#')
|
||||
secret :: Text -> Text -> Text -> Markdown
|
||||
secret b s a
|
||||
| T.null a || T.null s || T.head s == ' ' || T.last s == ' ' =
|
||||
unmarked $ '#' `T.cons` ss
|
||||
unmarked $ '#' `T.cons` ss
|
||||
| otherwise = markdown Secret $ T.init ss
|
||||
where
|
||||
ss = b <> s <> a
|
||||
@ -218,8 +226,8 @@ markdownP = mconcat <$> A.many' fragmentP
|
||||
wordMD s
|
||||
| T.null s = unmarked s
|
||||
| isUri s = case strDecode $ encodeUtf8 s of
|
||||
Right cReq -> markdown (simplexUriFormat cReq) s
|
||||
_ -> markdown Uri s
|
||||
Right cReq -> markdown (simplexUriFormat cReq) s
|
||||
_ -> markdown Uri s
|
||||
| isEmail s = markdown Email s
|
||||
| otherwise = unmarked s
|
||||
isUri s = T.length s >= 10 && any (`T.isPrefixOf` s) ["http://", "https://", "simplex:/"]
|
||||
|
136
src/Simplex/Chat/MarkdownDiff.hs
Normal file
136
src/Simplex/Chat/MarkdownDiff.hs
Normal file
@ -0,0 +1,136 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
|
||||
{-# HLINT ignore "Use newtype instead of data" #-}
|
||||
|
||||
module Simplex.Chat.MarkdownDiff
|
||||
( DiffChar (..),
|
||||
DiffPlainChar (..),
|
||||
DiffFormatStatus (..),
|
||||
FormatChar (..),
|
||||
diff,
|
||||
plainDiff,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Diff.Myers as D
|
||||
import qualified Data.Foldable as F
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Sequence (Seq (..), (><))
|
||||
import qualified Data.Sequence as S
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Chat.Markdown (EditAction (..), Format)
|
||||
|
||||
data DiffFormatStatus
|
||||
= UnchangedFormat
|
||||
| ChangedToFormat (Maybe Format)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data DiffChar = DiffChar FormatChar (Maybe EditAction)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data DiffPlainChar = DiffPlainChar Char (Maybe EditAction)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data FormatChar = FormatChar
|
||||
{ char :: Char,
|
||||
format :: Maybe Format
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
newtype DeleteIndices = DeleteIndices (Seq Int) deriving (Show, Eq)
|
||||
|
||||
newtype InsertIndices = InsertIndices (Seq Int) deriving (Show, Eq)
|
||||
|
||||
plainDiff :: T.Text -> T.Text -> Seq DiffPlainChar
|
||||
plainDiff left right = toPlain <$> formattedDiff
|
||||
where
|
||||
formattedDiff = diff (toFormatted left) (toFormatted right)
|
||||
toPlain :: DiffChar -> DiffPlainChar
|
||||
toPlain (DiffChar (FormatChar c _) editAction) = DiffPlainChar c editActionPlain
|
||||
where
|
||||
editActionPlain = case editAction of
|
||||
Just EAInsert -> Just EAInsert
|
||||
Just EADelete -> Just EADelete
|
||||
Just EAChangeFormat -> Nothing
|
||||
Nothing -> Nothing
|
||||
|
||||
toFormatted :: T.Text -> Seq FormatChar
|
||||
toFormatted = fmap (`FormatChar` Nothing) . S.fromList . T.unpack
|
||||
|
||||
diff :: Seq FormatChar -> Seq FormatChar -> Seq DiffChar
|
||||
diff left right = addInserts markDeletesAndUnchangedChars
|
||||
where
|
||||
edits = D.diffTexts (toText left) (toText right)
|
||||
(DeleteIndices deleteIndicies, InsertIndices insertIndicies) = indices
|
||||
|
||||
toText :: Seq FormatChar -> T.Text
|
||||
toText = T.pack . F.toList . fmap char
|
||||
|
||||
indices :: (DeleteIndices, InsertIndices)
|
||||
indices = F.foldl' f (DeleteIndices S.empty, InsertIndices S.empty) edits
|
||||
where
|
||||
f :: (DeleteIndices, InsertIndices) -> D.Edit -> (DeleteIndices, InsertIndices)
|
||||
f (x@(DeleteIndices ds), y@(InsertIndices is)) e = case e of
|
||||
D.EditDelete m n -> (x', y) where x' = DeleteIndices $ ds >< S.fromList [m .. n]
|
||||
D.EditInsert _ m n -> (x, y') where y' = InsertIndices $ is >< S.fromList [m .. n]
|
||||
|
||||
unchangedChars :: Map Int DiffFormatStatus -- indexed in left
|
||||
unchangedChars = F.foldl' f mempty unchangedCharPairs
|
||||
where
|
||||
unchangedCharPairs :: Seq (Int, FormatChar, FormatChar)
|
||||
unchangedCharPairs = g <$> S.zip leftWithoutDeletes rightWithoutInserts
|
||||
|
||||
leftWithoutDeletes :: Seq (Int, FormatChar)
|
||||
leftWithoutDeletes =
|
||||
S.filter (\(i, _) -> i `notElem` deleteIndicies) $
|
||||
S.zip (S.fromList [0 .. S.length left - 1]) left
|
||||
|
||||
rightWithoutInserts :: Seq (Int, FormatChar)
|
||||
rightWithoutInserts =
|
||||
S.filter (\(i, _) -> i `notElem` insertIndicies) $
|
||||
S.zip (S.fromList [0 .. S.length right - 1]) right
|
||||
|
||||
f :: Map Int DiffFormatStatus -> (Int, FormatChar, FormatChar) -> Map Int DiffFormatStatus
|
||||
f acc (i, FormatChar _ fL, FormatChar _ fR) = M.insert i x acc
|
||||
where
|
||||
x = if fL == fR then UnchangedFormat else ChangedToFormat fR
|
||||
|
||||
g :: ((Int, FormatChar), (Int, FormatChar)) -> (Int, FormatChar, FormatChar)
|
||||
g ((i, c), (_, d)) = (i, c, d)
|
||||
|
||||
markDeletesAndUnchangedChars :: Seq DiffChar
|
||||
markDeletesAndUnchangedChars = S.mapWithIndex f left
|
||||
where
|
||||
f :: Int -> FormatChar -> DiffChar
|
||||
f i x@(FormatChar c _)
|
||||
| i `elem` deleteIndicies = DiffChar x (Just EADelete)
|
||||
| otherwise = case unchangedChars M.! i of -- should never error
|
||||
UnchangedFormat -> DiffChar x Nothing
|
||||
ChangedToFormat f' -> DiffChar (FormatChar c f') (Just EAChangeFormat)
|
||||
addInserts :: Seq DiffChar -> Seq DiffChar
|
||||
addInserts base = F.foldr f base edits -- start from end and work backwards, hence foldr
|
||||
where
|
||||
f :: D.Edit -> Seq DiffChar -> Seq DiffChar
|
||||
f e acc = case e of
|
||||
D.EditDelete _ _ -> acc
|
||||
D.EditInsert i m n -> S.take i' acc >< inserts >< S.drop i' acc
|
||||
where
|
||||
-- D.EditInsert i m n -> S.take i acc >< inserts >< S.drop i acc
|
||||
-- if ok to have inserts before deletes, use i not i'
|
||||
-- Using i of course is faster, but perhaps i' approach can be optimised
|
||||
|
||||
i' = slidePastDeleteBlock i
|
||||
|
||||
slidePastDeleteBlock :: Int -> Int
|
||||
slidePastDeleteBlock x = case S.lookup x acc of
|
||||
Nothing -> x
|
||||
Just (DiffChar _ diffStatus) ->
|
||||
if diffStatus == Just EADelete
|
||||
then slidePastDeleteBlock (x + 1)
|
||||
else x
|
||||
|
||||
rightFormatChars = S.take (n - m + 1) $ S.drop m right
|
||||
inserts = fmap (`DiffChar` Just EAInsert) rightFormatChars
|
334
tests/MarkdownDiffTests.hs
Normal file
334
tests/MarkdownDiffTests.hs
Normal file
@ -0,0 +1,334 @@
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module MarkdownDiffTests where
|
||||
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Simplex.Chat.Markdown
|
||||
import Simplex.Chat.MarkdownDiff
|
||||
import System.Console.ANSI.Types
|
||||
import Test.Hspec
|
||||
|
||||
markdownDiffTests :: Spec
|
||||
markdownDiffTests = do
|
||||
formattedEditedTextTests
|
||||
|
||||
formattedEditedTextTests :: Spec
|
||||
formattedEditedTextTests = describe "show edits" do
|
||||
it "empty no change" $
|
||||
diff [] [] `shouldBe` []
|
||||
it "no change" $
|
||||
diff [FormatChar 'H' Nothing] [FormatChar 'H' Nothing]
|
||||
`shouldBe` [DiffChar (FormatChar 'H' Nothing) Nothing]
|
||||
it "add 1 char to empty" $
|
||||
diff [] [FormatChar 'H' Nothing]
|
||||
`shouldBe` [DiffChar (FormatChar 'H' Nothing) $ Just EAInsert]
|
||||
it "del the one and only" $
|
||||
diff [FormatChar 'H' Nothing] []
|
||||
`shouldBe` [DiffChar (FormatChar 'H' Nothing) $ Just EADelete]
|
||||
it "one character change" do
|
||||
diff
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'r' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'o' Nothing
|
||||
]
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'e' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'o' Nothing
|
||||
]
|
||||
`shouldBe` [ DiffChar (FormatChar 'H' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'r' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'e' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'l' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'l' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'o' Nothing) Nothing
|
||||
]
|
||||
|
||||
it "more1" do
|
||||
diff
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'r' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'o' Nothing
|
||||
]
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'e' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'o' Nothing,
|
||||
FormatChar 'x' Nothing,
|
||||
FormatChar 'y' Nothing,
|
||||
FormatChar 'z' Nothing
|
||||
]
|
||||
`shouldBe` [ DiffChar (FormatChar 'H' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'r' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'e' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'l' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'l' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'o' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'x' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'y' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'z' Nothing) $ Just EAInsert
|
||||
]
|
||||
|
||||
it "more2" do
|
||||
diff
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'r' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'o' Nothing
|
||||
]
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'e' Nothing,
|
||||
FormatChar 'x' Nothing,
|
||||
FormatChar 'y' Nothing,
|
||||
FormatChar 'z' Nothing,
|
||||
FormatChar 'o' Nothing
|
||||
]
|
||||
`shouldBe` [ DiffChar (FormatChar 'H' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'r' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'l' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'l' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'e' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'x' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'y' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'z' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'o' Nothing) Nothing
|
||||
]
|
||||
|
||||
it "more3" do
|
||||
diff
|
||||
[ FormatChar 'H' $ Just Bold,
|
||||
FormatChar 'H' $ Just Bold,
|
||||
FormatChar 'r' Nothing,
|
||||
FormatChar 'l' $ Just Secret,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'o' $ Just $ colored Green
|
||||
]
|
||||
[ FormatChar 'H' $ Just Italic,
|
||||
FormatChar 'H' $ Just Bold,
|
||||
FormatChar 'e' $ Just $ colored Cyan,
|
||||
FormatChar 'x' Nothing,
|
||||
FormatChar 'y' Nothing,
|
||||
FormatChar 'z' $ Just Secret,
|
||||
FormatChar 'o' $ Just $ colored Blue
|
||||
]
|
||||
`shouldBe` [ DiffChar (FormatChar 'H' (Just Italic)) (Just EAChangeFormat),
|
||||
DiffChar (FormatChar 'H' (Just Bold)) Nothing,
|
||||
DiffChar (FormatChar 'r' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'l' (Just Secret)) $ Just EADelete,
|
||||
DiffChar (FormatChar 'l' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'e' (Just $ colored Cyan)) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'x' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'y' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'z' (Just Secret)) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'o' (Just $ colored Blue)) (Just EAChangeFormat)
|
||||
]
|
||||
|
||||
it "more4" do
|
||||
diff
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'r' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar '~' Nothing,
|
||||
FormatChar '!' Nothing,
|
||||
FormatChar '@' Nothing,
|
||||
FormatChar 'l' Nothing,
|
||||
FormatChar 'o' Nothing
|
||||
]
|
||||
[ FormatChar 'H' Nothing,
|
||||
FormatChar 'e' Nothing,
|
||||
FormatChar 'r' Nothing,
|
||||
FormatChar 'x' Nothing,
|
||||
FormatChar 'y' Nothing,
|
||||
FormatChar '!' Nothing,
|
||||
FormatChar '@' Nothing,
|
||||
FormatChar 'z' Nothing,
|
||||
FormatChar 'o' Nothing,
|
||||
FormatChar '1' Nothing,
|
||||
FormatChar '2' Nothing
|
||||
]
|
||||
`shouldBe` [ DiffChar (FormatChar 'H' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'e' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'r' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'l' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar '~' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'x' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'y' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar '!' Nothing) Nothing,
|
||||
DiffChar (FormatChar '@' Nothing) Nothing,
|
||||
DiffChar (FormatChar 'l' Nothing) $ Just EADelete,
|
||||
DiffChar (FormatChar 'z' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar 'o' Nothing) Nothing,
|
||||
DiffChar (FormatChar '1' Nothing) $ Just EAInsert,
|
||||
DiffChar (FormatChar '2' Nothing) $ Just EAInsert
|
||||
]
|
||||
|
||||
it "SimplexLink 1" do
|
||||
diff
|
||||
[ FormatChar '>' $
|
||||
Just $
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/2/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host1", "host2", "host3"]
|
||||
}
|
||||
]
|
||||
[ FormatChar '>' $
|
||||
Just
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/3/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host0", "host2", "host3"]
|
||||
}
|
||||
]
|
||||
`shouldBe` [ DiffChar
|
||||
( FormatChar '>' $
|
||||
Just
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/3/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host0", "host2", "host3"]
|
||||
}
|
||||
)
|
||||
(Just EAChangeFormat)
|
||||
]
|
||||
|
||||
it "SimplexLink 2" do
|
||||
diff
|
||||
[ FormatChar '>' $
|
||||
Just $
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/2/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host1", "host2", "host3"]
|
||||
}
|
||||
]
|
||||
[ FormatChar '>' $
|
||||
Just
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/3/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host1", "host2", "host3"]
|
||||
}
|
||||
]
|
||||
`shouldBe` [ DiffChar
|
||||
( FormatChar '>' $
|
||||
Just
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/3/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host1", "host2", "host3"]
|
||||
}
|
||||
)
|
||||
(Just EAChangeFormat)
|
||||
]
|
||||
|
||||
it "SimplexLink 3" do
|
||||
diff
|
||||
[ FormatChar '>' $
|
||||
Just $
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/2/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host1", "host2", "host3"]
|
||||
}
|
||||
]
|
||||
[ FormatChar '>' $
|
||||
Just
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/2/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host0", "host2", "host3"]
|
||||
}
|
||||
]
|
||||
`shouldBe` [ DiffChar
|
||||
( FormatChar '>' $
|
||||
Just
|
||||
SimplexLink
|
||||
{ linkType = XLContact,
|
||||
simplexUri = "https://api.twitter.com/2/tweets/:id",
|
||||
trustedUri = True,
|
||||
smpHosts = NE.fromList ["host0", "host2", "host3"]
|
||||
}
|
||||
)
|
||||
(Just EAChangeFormat)
|
||||
]
|
||||
|
||||
it "plainDiff 1" do
|
||||
plainDiff
|
||||
"https://api.twitter.com/2/tweets/:id"
|
||||
"https://api.twitter.com/3/tweets/:id"
|
||||
`shouldBe` [ DiffPlainChar 'h' Nothing,
|
||||
DiffPlainChar 't' Nothing,
|
||||
DiffPlainChar 't' Nothing,
|
||||
DiffPlainChar 'p' Nothing,
|
||||
DiffPlainChar 's' Nothing,
|
||||
DiffPlainChar ':' Nothing,
|
||||
DiffPlainChar '/' Nothing,
|
||||
DiffPlainChar '/' Nothing,
|
||||
DiffPlainChar 'a' Nothing,
|
||||
DiffPlainChar 'p' Nothing,
|
||||
DiffPlainChar 'i' Nothing,
|
||||
DiffPlainChar '.' Nothing,
|
||||
DiffPlainChar 't' Nothing,
|
||||
DiffPlainChar 'w' Nothing,
|
||||
DiffPlainChar 'i' Nothing,
|
||||
DiffPlainChar 't' Nothing,
|
||||
DiffPlainChar 't' Nothing,
|
||||
DiffPlainChar 'e' Nothing,
|
||||
DiffPlainChar 'r' Nothing,
|
||||
DiffPlainChar '.' Nothing,
|
||||
DiffPlainChar 'c' Nothing,
|
||||
DiffPlainChar 'o' Nothing,
|
||||
DiffPlainChar 'm' Nothing,
|
||||
DiffPlainChar '/' Nothing,
|
||||
DiffPlainChar '2' $ Just EADelete,
|
||||
DiffPlainChar '3' $ Just EAInsert,
|
||||
DiffPlainChar '/' Nothing,
|
||||
DiffPlainChar 't' Nothing,
|
||||
DiffPlainChar 'w' Nothing,
|
||||
DiffPlainChar 'e' Nothing,
|
||||
DiffPlainChar 'e' Nothing,
|
||||
DiffPlainChar 't' Nothing,
|
||||
DiffPlainChar 's' Nothing,
|
||||
DiffPlainChar '/' Nothing,
|
||||
DiffPlainChar ':' Nothing,
|
||||
DiffPlainChar 'i' Nothing,
|
||||
DiffPlainChar 'd' Nothing
|
||||
]
|
||||
|
||||
it "plainDiff 2" do
|
||||
plainDiff
|
||||
"Hrl~!@lo"
|
||||
"Herxy!@zo12"
|
||||
`shouldBe` [ DiffPlainChar 'H' Nothing,
|
||||
DiffPlainChar 'e' $ Just EAInsert,
|
||||
DiffPlainChar 'r' Nothing,
|
||||
DiffPlainChar 'l' $ Just EADelete,
|
||||
DiffPlainChar '~' $ Just EADelete,
|
||||
DiffPlainChar 'x' $ Just EAInsert,
|
||||
DiffPlainChar 'y' $ Just EAInsert,
|
||||
DiffPlainChar '!' Nothing,
|
||||
DiffPlainChar '@' Nothing,
|
||||
DiffPlainChar 'l' $ Just EADelete,
|
||||
DiffPlainChar 'z' $ Just EAInsert,
|
||||
DiffPlainChar 'o' Nothing,
|
||||
DiffPlainChar '1' $ Just EAInsert,
|
||||
DiffPlainChar '2' $ Just EAInsert
|
||||
]
|
@ -5,6 +5,7 @@ import ChatTests
|
||||
import ChatTests.Utils (xdescribe'')
|
||||
import Control.Logger.Simple
|
||||
import Data.Time.Clock.System
|
||||
import MarkdownDiffTests
|
||||
import MarkdownTests
|
||||
import MobileTests
|
||||
import ProtocolTests
|
||||
@ -20,6 +21,7 @@ main = do
|
||||
withGlobalLogging logCfg . hspec $ do
|
||||
describe "Schema dump" schemaDumpTest
|
||||
describe "SimpleX chat markdown" markdownTests
|
||||
fdescribe "SimpleX chat markdown diff" markdownDiffTests
|
||||
describe "SimpleX chat view" viewTests
|
||||
describe "SimpleX chat protocol" protocolTests
|
||||
describe "WebRTC encryption" webRTCTests
|
||||
|
Loading…
Reference in New Issue
Block a user