Created
January 31, 2019 10:24
-
-
Save mizunashi-mana/d4c03b236f7a22d8c1ce411924ba1fe8 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module NaiveParser where | |
import Control.Monad | |
import Data.Maybe (fromMaybe) | |
import Text.ParserCombinators.Parsec | |
data Block = List [Block] | ListItem String | |
deriving Show | |
blockParser :: Maybe Int -> Parser Block | |
blockParser = blockParser' . fromMaybe 0 | |
-- | Parser for 'BulletPoint' | |
bulletPointParser :: Int -> Parser Block | |
bulletPointParser indentNum = do | |
-- Look ahead and count the number of spaces | |
numOfSpaces <- length <$> lookAhead (try $ many $ oneOf " \t") | |
when (numOfSpaces <= indentNum) $ fail "less indent" | |
blocks <- many1 $ blockParser' numOfSpaces | |
return $ List blocks | |
itemParser :: Int -> Parser Block | |
itemParser indentNum = do | |
replicateM_ indentNum (oneOf " \t") | |
ListItem <$> manyTill anyChar (try endOfLine) | |
blockParser' :: Int -> Parser Block | |
blockParser' numOfSpaces = | |
try (bulletPointParser numOfSpaces) | |
<|> try (itemParser numOfSpaces) | |
-- | End of line parser | |
endOfLine :: Parser () | |
endOfLine = void (char '\n') <|> void (string "\r\n") <|> eof | |
-- | Parse List Blocks | |
-- | |
-- >>> parseList exampleList == Right expecting | |
-- True | |
-- | |
parseList :: String -> Either ParseError [Block] | |
parseList = parse (manyTill (blockParser Nothing) eof) "List parser" | |
exampleList :: String | |
exampleList = unlines | |
[ " list1" | |
, " item1" | |
, " item2" | |
, " item3" | |
, " list2" | |
, " list3" | |
] | |
expecting :: [Block] | |
expecting = [ List | |
[ ListItem "list1" | |
, List | |
[ ListItem "item1" | |
, ListItem "item2" | |
, ListItem "item3" | |
] | |
, ListItem "list2" | |
, ListItem "list3" | |
] | |
] | |
-- | Perform some operation on 'Just', given the field inside the 'Just'. | |
-- | |
-- > whenJust Nothing print == return () | |
-- > whenJust (Just 1) print == print 1 | |
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m () | |
whenJust mg f = maybe (pure ()) f mg |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment