module Conllu.Diff where
import Conllu.Type
import Conllu.Utils
import Data.Maybe
import Data.Ord
type FDiff = StringPair
type WDiff a = (CW a, CW a)
type SDiff a = [WDiff a]
type DDiff a = [SDiff a]
diffW :: WDiff a -> Bool
diffW = any isJust . printFieldDiffs
diffWs :: [CW a] -> [CW a] -> [WDiff a]
diffWs ws1 ws2 = filter diffW $ zip ws1 ws2
diffS :: (Sent, Sent) -> SDiff AW
diffS (s1, s2) = diffWs (_words s1) (_words s2)
diffSs :: [(Sent, Sent)] -> DDiff AW
diffSs = fmap diffS
showM :: Show a => Maybe a -> String
showM (Just x) = show x
showM Nothing = "_"
pairSentsBy ::
(Sent -> Sent -> Ordering) -> [Sent] -> [Sent] -> [(Sent, Sent)]
pairSentsBy _f [] _ss = []
pairSentsBy _f _ss [] = []
pairSentsBy f ss1@(s1:st1) ss2@(s2:st2) =
case f s1 s2 of
LT -> pairSentsBy f st1 ss2
GT -> pairSentsBy f ss1 st2
EQ -> (s1, s2) : pairSentsBy f st1 st2
sentId :: Sent -> Maybe Index
sentId s =
let mi = lookup "sent_id " $ _meta s
i = fromMaybe "0" mi
in safeRead i :: Maybe Index
pairSents :: [Sent] -> [Sent] -> [(Sent, Sent)]
pairSents = pairSentsBy $ comparing sentId
printFieldDiffs :: WDiff a -> [Maybe StringPair]
printFieldDiffs (w1, w2) = fmap (diffField w1 w2) pfs
where
diffField w w' pf =
let pf1 = pf w
pf2 = pf w'
in if pf1 /= pf2
then Just (pf1, pf2)
else Nothing
pfs =
[ showM . _form
, showM . _lemma
, showM . _upos
, showM . _xpos
, show . _feats
, showM . _rel
, show . _deps
, showM . _misc
]
printWDiff :: WDiff a -> [StringPair]
printWDiff = catMaybes . printFieldDiffs
printSDiff :: SDiff a -> [[StringPair]]
printSDiff = fmap printWDiff
printDDiff :: DDiff a -> [[[StringPair]]]
printDDiff = fmap printSDiff