github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Remove old cata approach

Browse Source
This commit is contained in:
Timothy Clem 2016-12-09 14:47:35 -08:00
parent d84537ec42
commit fcff364131
1 changed files with 0 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Renderer/SExpression.hs
View File

@ -50,32 +50,3 @@ showAnnotation annotation = categoryName annotation <> " " <> showSourceSpan ann
categoryName :: HasField fields Category => Record fields -> Text
categoryName = toS . category
-- TODO: Move over to FDocs about how to understand structure of Diff as well as
-- the use of Free and Cofree on the different levels.
syntaxDiffToText :: HasField fields Category => Diff (Syntax Text) (Record fields) -> Text
syntaxDiffToText = cata algebra
where
algebra :: (HasField fields1 Category, HasField fields Category, Foldable t) => FreeF (TermF t (Both (Record fields1))) (Patch (Term (Syntax Text) (Record fields))) Text -> Text
algebra diff = case diff of
-- Pure nodes are patches (what's changed)
(Pure patch) -> patchFields patch
-- Free nodes are context
(Free (Join (_, annotation) :< syntax)) -> "(" <> categoryName annotation <> unwords (toList syntax) <> ")"
patchFields :: HasField fields Category => Patch (Term (Syntax Text) (Record fields)) -> Text
patchFields patch = case patch of
Insert term -> fields "+" term
Delete term -> fields "-" term
Replace a b -> "(" <> termFields a <> "->" <> termFields b <> ")"
where
fields kind term = "(" <> kind <> termFields term <> ")"
termFields :: HasField fields Category => Term (Syntax Text) (Record fields) -> Text
termFields = cata algebra
where
algebra :: HasField fields Category => TermF (Syntax leaf) (Record fields) Text -> Text
algebra term = case term of
(annotation :< Leaf _) -> categoryName annotation
(annotation :< syntax) -> categoryName annotation <> "(" <> unwords (toList syntax) <> ")"