Skip to content

Commit 6fa3f99

Browse files
decioferreiradecioferreira
committed
WIP format
1 parent 0d55400 commit 6fa3f99

File tree

17 files changed

+1300
-551
lines changed

17 files changed

+1300
-551
lines changed

‎src/Common/Format/Cheapskate/Inlines.elm

Lines changed: 143 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -313,7 +313,7 @@ pReference =
313313

314314
pEscaped : Parser String
315315
pEscaped =
316-
fmap String.fromChar (skip ((==) '\\') |> (\_ -> satisfy isEscapable))
316+
fmap String.fromChar (skip ((==) '\\') |> bind (\_ -> satisfy isEscapable))
317317

318318

319319

@@ -322,9 +322,8 @@ pEscaped =
322322

323323
pSatisfy : (Char -> Bool) -> Parser Char
324324
pSatisfy p =
325-
-- satisfy (\c -> c /= '\\' && p c)
326-
-- <|> (char '\\' *> satisfy (\c -> isEscapable c && p c))
327-
Debug.todo "pSatisfy"
325+
oneOf (satisfy (\c -> c /= '\\' && p c))
326+
(char '\\' |> bind (\_ -> satisfy (\c -> isEscapable c && p c)))
328327

329328

330329

@@ -337,7 +336,7 @@ parseInlines refmap t =
337336
case parse (fmap List.concat (leftSequence (many (pInline refmap)) endOfInput)) t of
338337
Err e ->
339338
-- should not happen
340-
crash ("parseInlines: " ++ Debug.toString e)
339+
crash ("parseInlines: " ++ showParseError e)
341340

342341
Ok r ->
343342
r
@@ -642,17 +641,29 @@ schemeSet =
642641

643642
pUri : String -> Parser Inlines
644643
pUri scheme =
645-
-- do
646-
-- _ <- char ':'
647-
-- x <- scan (OpenParens 0) uriScanner
648-
-- guard $ not $ T.null x
649-
-- let (rawuri, endingpunct) =
650-
-- case T.last x of
651-
-- c | c `elem` (".;?!:," :: String) ->
652-
-- (scheme <> ":" <> T.init x, singleton (Str (T.singleton c)))
653-
-- _ -> (scheme <> ":" <> x, mempty)
654-
-- return $ autoLink rawuri <> endingpunct
655-
Debug.todo "pUri"
644+
char ':'
645+
|> bind (\_ -> scan (OpenParens 0) uriScanner)
646+
|> bind
647+
(\x ->
648+
guard (not (String.isEmpty x))
649+
|> bind
650+
(\_ ->
651+
let
652+
( rawuri, endingpunct ) =
653+
case String.uncons (String.reverse x) of
654+
Just ( c, _ ) ->
655+
if String.contains (String.fromChar c) ".;?!:," then
656+
( scheme ++ ":" ++ x, [ Str (String.fromChar c) ] )
657+
658+
else
659+
( scheme ++ ":" ++ x, [] )
660+
661+
_ ->
662+
( scheme ++ ":" ++ x, [] )
663+
in
664+
return (autoLink rawuri ++ endingpunct)
665+
)
666+
)
656667

657668

658669

@@ -670,22 +681,42 @@ type OpenParens
670681
= OpenParens Int
671682

672683

684+
uriScanner : OpenParens -> Char -> Maybe OpenParens
685+
uriScanner st c =
686+
case ( st, c ) of
687+
( _, ' ' ) ->
688+
Nothing
689+
690+
( _, '\n' ) ->
691+
Nothing
692+
693+
( OpenParens n, '(' ) ->
694+
Just (OpenParens (n + 1))
673695

674-
-- uriScanner : OpenParens -> Char -> Maybe OpenParens
675-
-- uriScanner _ ' ' = Nothing
676-
-- uriScanner _ '\n' = Nothing
677-
-- uriScanner (OpenParens n) '(' = Just (OpenParens (n + 1))
678-
-- uriScanner (OpenParens n) ')'
679-
-- | n > 0 = Just (OpenParens (n - 1))
680-
-- | otherwise = Nothing
681-
-- uriScanner st '+' = Just st
682-
-- uriScanner st '/' = Just st
683-
-- uriScanner _ c | isSpace c = Nothing
684-
-- uriScanner st _ = Just st
685-
-- Parses material enclosed in *s, **s, _s, or __s.
686-
-- Designed to avoid backtracking.
696+
( OpenParens n, ')' ) ->
697+
if n > 0 then
698+
Just (OpenParens (n - 1))
687699

700+
else
701+
Nothing
702+
703+
( _, '+' ) ->
704+
Just st
705+
706+
( _, '/' ) ->
707+
Just st
708+
709+
_ ->
710+
if isSpace c then
711+
Nothing
688712

713+
else
714+
Just st
715+
716+
717+
{-| Parses material enclosed in \*s, \*\*s, \_s, or \_\_s.
718+
Designed to avoid backtracking.
719+
-}
689720
pEnclosure : Char -> ReferenceMap -> Parser Inlines
690721
pEnclosure c refmap =
691722
takeWhile1 ((==) c)
@@ -709,10 +740,8 @@ pEnclosure c refmap =
709740
)
710741

711742

712-
713-
-- singleton sequence or empty if contents are empty
714-
715-
743+
{-| singleton sequence or empty if contents are empty
744+
-}
716745
single : (Inlines -> Inline) -> Inlines -> Inlines
717746
single constructor ils =
718747
if List.isEmpty ils then
@@ -722,51 +751,59 @@ single constructor ils =
722751
List.singleton (constructor ils)
723752

724753

725-
726-
-- parse inlines til you hit a c, and emit Emph.
727-
-- if you never hit a c, emit '*' + inlines parsed.
728-
729-
754+
{-| parse inlines til you hit a c, and emit Emph.
755+
if you never hit a c, emit '\*' + inlines parsed.
756+
-}
730757
pOne : Char -> ReferenceMap -> Inlines -> Parser Inlines
731758
pOne c refmap prefix =
732-
-- do
733-
-- contents <- msum <$> many ( (nfbChar c >> pInline refmap)
734-
-- <|> (string (T.pack [c,c]) >>
735-
-- nfbChar c >> pTwo c refmap mempty) )
736-
-- (char c >> return (single Emph $ prefix <> contents))
737-
-- <|> return (singleton (Str (T.singleton c)) <> (prefix <> contents))
738-
Debug.todo "pOne"
739-
740-
741-
742-
-- parse inlines til you hit two c's, and emit Strong.
743-
-- if you never do hit two c's, emit '**' plus + inlines parsed.
759+
fmap List.concat
760+
(many
761+
(oneOf (nfbChar c |> bind (\_ -> pInline refmap))
762+
(string (String.fromList [ c, c ])
763+
|> bind (\_ -> nfbChar c)
764+
|> bind (\_ -> pTwo c refmap [])
765+
)
766+
)
767+
)
768+
|> bind
769+
(\contents ->
770+
oneOf (char c |> bind (\_ -> return (single Emph (prefix ++ contents))))
771+
(return (Str (String.fromChar c) :: (prefix ++ contents)))
772+
)
744773

745774

775+
{-| parse inlines til you hit two c's, and emit Strong.
776+
if you never do hit two c's, emit '\*\*' plus + inlines parsed.
777+
-}
746778
pTwo : Char -> ReferenceMap -> Inlines -> Parser Inlines
747779
pTwo c refmap prefix =
748-
-- do
749-
-- let ender = string $ T.pack [c,c]
750-
-- contents <- msum <$> many (nfb ender >> pInline refmap)
751-
-- (ender >> return (single Strong $ prefix <> contents))
752-
-- <|> return (singleton (Str $ T.pack [c,c]) <> (prefix <> contents))
753-
Debug.todo "pTwo"
754-
755-
756-
757-
-- parse inlines til you hit one c or a sequence of two c's.
758-
-- If one c, emit Emph and then parse pTwo.
759-
-- if two c's, emit Strong and then parse pOne.
780+
let
781+
ender : Parser String
782+
ender =
783+
string (String.fromList [ c, c ])
784+
in
785+
fmap List.concat (many (nfb ender |> bind (\_ -> pInline refmap)))
786+
|> bind
787+
(\contents ->
788+
oneOf (ender |> fmap (\_ -> single Strong (prefix ++ contents)))
789+
(return (Str (String.fromList [ c, c ]) :: (prefix ++ contents)))
790+
)
760791

761792

793+
{-| parse inlines til you hit one c or a sequence of two c's.
794+
If one c, emit Emph and then parse pTwo.
795+
if two c's, emit Strong and then parse pOne.
796+
-}
762797
pThree : Char -> ReferenceMap -> Parser Inlines
763798
pThree c refmap =
764-
-- do
765-
-- contents <- msum <$> (many (nfbChar c >> pInline refmap))
766-
-- (string (T.pack [c,c]) >> (pOne c refmap (single Strong contents)))
767-
-- <|> (char c >> (pTwo c refmap (single Emph contents)))
768-
-- <|> return (singleton (Str $ T.pack [c,c,c]) <> contents)
769-
Debug.todo "pThree"
799+
fmap List.concat (many (nfbChar c |> bind (\_ -> pInline refmap)))
800+
|> bind
801+
(\contents ->
802+
oneOf (string (String.fromList [ c, c ]) |> bind (\_ -> pOne c refmap (single Strong contents)))
803+
(oneOf (char c |> bind (\_ -> pTwo c refmap (single Emph contents)))
804+
(return (Str (String.fromList [ c, c, c ]) :: contents))
805+
)
806+
)
770807

771808

772809

@@ -827,14 +864,22 @@ pLink refmap =
827864

828865
pInlineLink : Inlines -> Parser Inlines
829866
pInlineLink lab =
830-
-- do
831-
-- _ <- char '('
832-
-- scanSpaces
833-
-- url <- pLinkUrl
834-
-- tit <- option "" $ scanSpnl *> pLinkTitle <* scanSpaces
835-
-- _ <- char ')'
836-
-- return $ singleton $ Link lab (Url url) tit
837-
Debug.todo "pInlineLink"
867+
char '('
868+
|> bind
869+
(\_ ->
870+
scanSpaces
871+
|> bind (\_ -> pLinkUrl)
872+
|> bind
873+
(\url ->
874+
-- tit <- option "" $ scanSpnl *> pLinkTitle <* scanSpaces
875+
option "" (scanSpnl |> bind (\_ -> bind (\_ -> pLinkTitle) scanSpaces))
876+
|> bind
877+
(\tit ->
878+
char ')'
879+
|> fmap (\_ -> [ Link lab (Url url) tit ])
880+
)
881+
)
882+
)
838883

839884

840885

@@ -843,10 +888,8 @@ pInlineLink lab =
843888

844889
pReferenceLink : ReferenceMap -> String -> Inlines -> Parser Inlines
845890
pReferenceLink _ rawlab lab =
846-
-- do
847-
-- ref <- option rawlab $ scanSpnl >> pLinkLabel
848-
-- return $ singleton $ Link lab (Ref ref) ""
849-
Debug.todo "pReferenceLink"
891+
option rawlab (scanSpnl |> bind (\_ -> pLinkLabel))
892+
|> fmap (\ref -> [ Link lab (Ref ref) "" ])
850893

851894

852895

@@ -961,19 +1004,27 @@ pAutolink =
9611004

9621005
autoLink : String -> Inlines
9631006
autoLink t =
964-
-- singleton $ Link (toInlines t) (Url t) (T.empty)
965-
-- where toInlines t' = case parse pToInlines t' of
966-
-- Right r -> r
967-
-- Left e -> error $ "autolink: " ++ show e
968-
-- pToInlines = mconcat <$> many strOrEntity
969-
-- strOrEntity = ((singleton . Str) <$> takeWhile1 (/='&'))
970-
-- <|> pEntity
971-
-- <|> ((singleton . Str) <$> string "&")
972-
Debug.todo "autoLink"
1007+
let
1008+
toInlines t_ =
1009+
case parse pToInlines t_ of
1010+
Ok r ->
1011+
r
1012+
1013+
Err e ->
1014+
crash <| "autolink: " ++ showParseError e
1015+
1016+
pToInlines : Parser Inlines
1017+
pToInlines =
1018+
fmap List.concat (many strOrEntity)
1019+
1020+
strOrEntity : Parser Inlines
1021+
strOrEntity =
1022+
oneOf (fmap (List.singleton << Str) (takeWhile1 ((/=) '&')))
1023+
(oneOf pEntity (fmap (List.singleton << Str) (string "&")))
1024+
in
1025+
List.singleton <| Link (toInlines t) (Url t) ""
9731026

9741027

9751028
emailLink : String -> Inlines
9761029
emailLink t =
977-
-- singleton $ Link (singleton $ Str t)
978-
-- (Url $ "mailto:" <> t) (T.empty)
979-
Debug.todo "emailLink"
1030+
[ Link [ Str t ] (Url ("mailto:" ++ t)) "" ]

0 commit comments

Comments
 (0)