github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Render patches and terms to HTML (maybe)

Browse Source
This commit is contained in:
Rob Rix 2015-12-01 15:39:55 -05:00
parent cc5cca02f7
commit c44418272c
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
app/Split.hs
View File

@ -26,12 +26,12 @@ split _ _ _ = return mempty
splitDiff :: Diff a Info -> String -> String -> [(String, String)]
splitDiff _ _ _ = []
splitPatch :: String -> String -> Patch (Term a Info) -> (Maybe (Element a), Maybe (Element a))
splitPatch :: String -> String -> Patch (Term a Info) -> (Maybe HTML, Maybe HTML)
splitPatch before after patch = (fmap (splitTerm before) $ Patch.before patch, fmap (splitTerm after) $ Patch.after patch)
splitTerm :: String -> Term a Info -> Element a
splitTerm source term = toElement term where
toElement ((Info range lineRange categories) :< syntax) = (foldr (const . Just) Nothing categories, substring range source) :< fmap toElement syntax
splitTerm :: String -> Term a Info -> HTML
splitTerm source term = cata toElement term where
toElement (Info range lineRange categories) (Leaf _) = Span (classify categories) $ substring range source
classify :: Set.Set Category -> Maybe ClassName
classify categories = foldr (const . Just) Nothing categories