mirror of
https://github.com/aelve/guide.git
synced 2024-11-27 10:10:50 +03:00
81 lines
2.3 KiB
Haskell
81 lines
2.3 KiB
Haskell
|
{-# LANGUAGE
|
||
|
|
OverloadedStrings,
|
||
|
|
NoImplicitPrelude
|
||
|
|
#-}
|
||
|
|
|
||
|
|
|
||
|
|
module Merge
|
||
|
|
(
|
||
|
|
merge,
|
||
|
|
)
|
||
|
|
where
|
||
|
|
|
||
|
|
|
||
|
|
import BasePrelude
|
||
|
|
-- Lenses
|
||
|
|
import Lens.Micro.Platform hiding ((&))
|
||
|
|
-- Text
|
||
|
|
import qualified Data.Text.All as T
|
||
|
|
import Data.Text.All (Text)
|
||
|
|
import Data.List.Split
|
||
|
|
-- Vector
|
||
|
|
import qualified Data.Vector as V
|
||
|
|
-- Diffing
|
||
|
|
import qualified Data.Patch as PV
|
||
|
|
|
||
|
|
|
||
|
|
-- | An implementation of a 3-way diff and merge.
|
||
|
|
merge
|
||
|
|
:: Text -- ^ Original text
|
||
|
|
-> Text -- ^ Variant A (preferred)
|
||
|
|
-> Text -- ^ Variant B
|
||
|
|
-> Text -- ^ Merged text
|
||
|
|
merge orig a b = T.concat . V.toList $ PV.apply (pa <> pb') orig'
|
||
|
|
where
|
||
|
|
(orig', a', b') = (orig, a, b) & each %~
|
||
|
|
V.fromList . consolidate . map T.toStrict . break' . T.toString
|
||
|
|
pa = PV.diff orig' a'
|
||
|
|
pb = PV.diff orig' b'
|
||
|
|
(_, pb') = PV.transformWith PV.ours pa pb
|
||
|
|
|
||
|
|
-- | Break a string into words, spaces, and special characters.
|
||
|
|
break' :: String -> [String]
|
||
|
|
break' = split . dropInitBlank . dropFinalBlank . dropInnerBlanks . whenElt $
|
||
|
|
\c -> not (isAlphaNum c) && c /= '\''
|
||
|
|
|
||
|
|
-- | Consolidate some of the things into tokens (like links, consecutive
|
||
|
|
-- spaces, and Markdown elements).
|
||
|
|
consolidate :: [Text] -> [Text]
|
||
|
|
-- spaces
|
||
|
|
consolidate s@(" ":_) =
|
||
|
|
let (l, r) = span (== " ") s
|
||
|
|
in T.concat l : consolidate r
|
||
|
|
-- breaks between paragraphs
|
||
|
|
consolidate s@("\n":_) =
|
||
|
|
let (l, r) = span (== "\n") s
|
||
|
|
in T.concat l : consolidate r
|
||
|
|
-- code block markers
|
||
|
|
consolidate s@("~":_) =
|
||
|
|
let (l, r) = span (== "~") s
|
||
|
|
in if length l >= 3 then T.concat l : consolidate r else l ++ consolidate r
|
||
|
|
consolidate s@("`":_) =
|
||
|
|
let (l, r) = span (== "`") s
|
||
|
|
in if length l >= 3 then T.concat l : consolidate r else l ++ consolidate r
|
||
|
|
-- hrules
|
||
|
|
consolidate s@("-":_) =
|
||
|
|
let (l, r) = span (== "-") s
|
||
|
|
in if length l >= 3 then T.concat l : consolidate r else l ++ consolidate r
|
||
|
|
-- ellipses
|
||
|
|
consolidate (".":".":".":xs) = "..." : consolidate xs
|
||
|
|
-- links
|
||
|
|
consolidate s@("http":":":"/":"/":_) =
|
||
|
|
let (l, r) = span (\x -> x /= ")" && not (isSpace (T.head x))) s
|
||
|
|
in T.concat l : consolidate r
|
||
|
|
consolidate s@("https":":":"/":"/":_) =
|
||
|
|
let (l, r) = span (\x -> x /= ")" && not (isSpace (T.head x))) s
|
||
|
|
in T.concat l : consolidate r
|
||
|
|
consolidate ("(":"@":"hk":")":xs) = "(" : "@hk" : ")" : consolidate xs
|
||
|
|
-- the rest
|
||
|
|
consolidate (x:xs) = x : consolidate xs
|
||
|
|
consolidate [] = []
|