mirror of
https://github.com/github/semantic.git
synced 2024-11-24 08:54:07 +03:00
add maybeFirstNewLine to look in Uls for new lines
This commit is contained in:
parent
f86f12b7f6
commit
bcb935c49b
17
src/Split.hs
17
src/Split.hs
@ -10,7 +10,7 @@ import Control.Comonad.Cofree
|
|||||||
import Range
|
import Range
|
||||||
import Control.Monad.Free
|
import Control.Monad.Free
|
||||||
import Data.ByteString.Lazy.Internal
|
import Data.ByteString.Lazy.Internal
|
||||||
import Text.Blaze.Html5
|
import Text.Blaze.Html5 hiding (map)
|
||||||
import qualified Text.Blaze.Html5.Attributes as A
|
import qualified Text.Blaze.Html5.Attributes as A
|
||||||
import Text.Blaze.Html.Renderer.Utf8
|
import Text.Blaze.Html.Renderer.Utf8
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
@ -27,6 +27,15 @@ data HTML =
|
|||||||
| Dt String
|
| Dt String
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
maybeFirstNewLine :: HTML -> Maybe HTML
|
||||||
|
maybeFirstNewLine text@(Text "") = Just text
|
||||||
|
maybeFirstNewLine text@(Text _) = Nothing
|
||||||
|
maybeFirstNewLine (Span _ _) = Nothing
|
||||||
|
maybeFirstNewLine (Dt _) = Nothing
|
||||||
|
maybeFirstNewLine (Ul _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements
|
||||||
|
maybeFirstNewLine (Dl _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements
|
||||||
|
maybeFirstNewLine (Div _ elements) = getFirst $ mconcat $ map First $ map maybeFirstNewLine elements
|
||||||
|
|
||||||
classifyMarkup :: Maybe ClassName -> Markup -> Markup
|
classifyMarkup :: Maybe ClassName -> Markup -> Markup
|
||||||
classifyMarkup (Just className) element = element ! A.class_ (stringValue className)
|
classifyMarkup (Just className) element = element ! A.class_ (stringValue className)
|
||||||
classifyMarkup _ element = element
|
classifyMarkup _ element = element
|
||||||
@ -172,8 +181,12 @@ adjoin2 [] row = [row]
|
|||||||
adjoin2 (Row EmptyLine EmptyLine : init) row = adjoin2 init row
|
adjoin2 (Row EmptyLine EmptyLine : init) row = adjoin2 init row
|
||||||
adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) =
|
adjoin2 (Row EmptyLine rights : Row lefts rights' : init) (Row xs ys) =
|
||||||
Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init
|
Row EmptyLine (rights <> ys) : Row (lefts <> xs) rights' : init
|
||||||
adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) =
|
adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs@(Line (node : _)) ys) | Just _ <- maybeFirstNewLine node =
|
||||||
Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init
|
Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init
|
||||||
|
-- adjoin2 (Row lefts EmptyLine : Row lefts' rights : init) (Row xs ys) =
|
||||||
|
-- Row (lefts <> xs) EmptyLine : Row lefts' (rights <> ys) : init
|
||||||
|
adjoin2 rows row@(Row (Line (node : _)) _) | Just _ <- maybeFirstNewLine node = row : rows
|
||||||
|
adjoin2 rows row@(Row _ (Line (node : _))) | Just _ <- maybeFirstNewLine node = row : rows
|
||||||
adjoin2 (last:init) row = (last <> row) : init
|
adjoin2 (last:init) row = (last <> row) : init
|
||||||
{-
|
{-
|
||||||
|
|
||||||
|
22
test/Spec.hs
22
test/Spec.hs
@ -77,6 +77,28 @@ main = hspec $ do
|
|||||||
(Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ])
|
(Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ])
|
||||||
], (Range 0 8, Range 0 8))
|
], (Range 0 8, Range 0 8))
|
||||||
|
|
||||||
|
it "" $
|
||||||
|
let (sourceA, sourceB) = ("[\na\n,\nb]", "[a,b]") in
|
||||||
|
annotatedToRows (formatted sourceA sourceB "branch" (Indexed [
|
||||||
|
Free . offsetAnnotated 2 1 $ unchanged "a" "leaf" (Leaf ""),
|
||||||
|
Free . offsetAnnotated 7 3 $ unchanged "b" "leaf" (Leaf "")
|
||||||
|
])) sourceA sourceB `shouldBe`
|
||||||
|
([
|
||||||
|
Row (Line [ Ul (Just "category-branch") [ Text "[" ] ])
|
||||||
|
(Line [ Ul (Just "category-branch") [ Text "[", span "a", Text ",", span "b", Text "]" ] ]),
|
||||||
|
Row (Line [ Ul (Just "category-branch") [ Text "", span "a" ] ])
|
||||||
|
EmptyLine,
|
||||||
|
Row (Line [ Ul (Just "category-branch") [ Text "", Text "," ] ])
|
||||||
|
EmptyLine,
|
||||||
|
Row (Line [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ])
|
||||||
|
EmptyLine
|
||||||
|
], (Range 0 8, Range 0 5))
|
||||||
|
|
||||||
|
describe "adjoin2" $ do
|
||||||
|
it "appends a row starting with a newline" $
|
||||||
|
adjoin2 [ Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ] (Row (Line [ Text "", Text "," ]) EmptyLine) `shouldBe`
|
||||||
|
[ Row (Line [ Text "", Text "," ]) EmptyLine, Row (Line [ Ul Nothing [ Text "[",Span Nothing "a" ]]) EmptyLine ]
|
||||||
|
|
||||||
where
|
where
|
||||||
info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ])
|
info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ])
|
||||||
unchanged source category = formatted source source category
|
unchanged source category = formatted source source category
|
||||||
|
Loading…
Reference in New Issue
Block a user