NaiveParser.hs

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