From: Nathaniel Wesley Filardo Date: Mon, 21 Sep 2015 15:59:06 +0000 (-0400) Subject: Move parse utilities to their own module X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=810170e8c646da110cb6208cb4ee22d67c5a90fe;p=grade Move parse utilities to their own module --- diff --git a/grade.cabal b/grade.cabal index b13d23d..06335f4 100644 --- a/grade.cabal +++ b/grade.cabal @@ -14,6 +14,7 @@ cabal-version: >=1.10 library exposed-modules: Grade.Types, + Grade.ParseUtils, Grade.Parse, Grade.Grade, Grade.Score.Zeroing, diff --git a/lib/Grade/Parse.hs b/lib/Grade/Parse.hs index 15f3cf1..fa6b2ba 100644 --- a/lib/Grade/Parse.hs +++ b/lib/Grade/Parse.hs @@ -15,9 +15,7 @@ import Control.Applicative -- import qualified Control.Lens as L -- import Control.Monad (guard, when) import Control.Monad.State -import Data.ByteString (ByteString) import Data.Text (Text,unpack) -import Data.Text.Encoding (decodeUtf8') -- import qualified Data.Char as C import qualified Data.Map as M -- import qualified Data.Set as S @@ -30,6 +28,7 @@ import qualified Text.Parser.LookAhead as T -- import qualified Text.PrettyPrint.ANSI.Leijen as PP import Grade.Types +import Grade.ParseUtils ------------------------------------------------------------------------ }}} -- Common -------------------------------------------------------------- {{{ @@ -38,34 +37,6 @@ commentStart, commentEnd :: (IsString s) => s commentStart = "$BEGIN_COMMENTS" commentEnd = "$END_COMMENTS" -toUtf8 :: (Monad f, T.Parsing f) => f ByteString -> f Text -toUtf8 = (>>= either (\e -> T.unexpected ("Invalid UTF-8: " ++ show e)) (pure) . decodeUtf8') - --- | Grab a comment beginning with # and going to end of line. -hashComment :: T.DeltaParsing f => f Text -hashComment = toUtf8 (T.sliced (T.char '#' *> many (T.noneOf "\r\n"))) <* T.whiteSpace --- hashComment = T.sliced (T.char '#' *> T.manyTill T.anyChar T.newline) <* T.whiteSpace - --- | Sometimes we want to be more forceful than T.whiteSpace and actually --- ensure that there is some space or that we're at the end of input. -sseof :: (T.TokenParsing f) => f () -sseof = (T.someSpace <|> T.eof) - --- | Grab a word in its entirety. Note that this is a little strange as --- we check the 'notFollowedBy' condition *first*! -word :: (T.DeltaParsing f) => f Text -word = toUtf8 (T.sliced (many $ T.notFollowedBy T.someSpace *> T.anyChar)) <* sseof - --- | Choose by key in a map -parseMapKeys :: (T.TokenParsing f) - => (k -> String) - -> M.Map k v - -> f (k, v) -parseMapKeys ks m = T.choice $ (uncurry arm) <$> M.toList m - where - arm k v = ((T.try ((T.string $ ks k) <* sseof)) *> pure (k,v)) - T. show (ks k) - ------------------------------------------------------------------------ }}} -- Defines ------------------------------------------------------------- {{{ diff --git a/lib/Grade/ParseUtils.hs b/lib/Grade/ParseUtils.hs new file mode 100644 index 0000000..fb718d6 --- /dev/null +++ b/lib/Grade/ParseUtils.hs @@ -0,0 +1,44 @@ +-- Header -------------------------------------------------------------- {{{ + +module Grade.ParseUtils ( + toUtf8, sseof, word, hashComment, parseMapKeys +) where + +import Control.Applicative +import Data.ByteString (ByteString) +import qualified Data.Map as M +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8') +import qualified Text.Trifecta as T + +------------------------------------------------------------------------ }}} + +toUtf8 :: (Monad f, T.Parsing f) => f ByteString -> f Text +toUtf8 = (>>= either (\e -> T.unexpected ("Invalid UTF-8: " ++ show e)) (pure) . decodeUtf8') + +-- | Sometimes we want to be more forceful than T.whiteSpace and actually +-- ensure that there is some space or that we're at the end of input. +sseof :: (T.TokenParsing f) => f () +sseof = (T.someSpace <|> T.eof) + +-- | Grab a word in its entirety. Note that this is a little strange as +-- we check the 'notFollowedBy' condition *first*! +word :: (T.DeltaParsing f) => f Text +word = toUtf8 (T.sliced (many $ T.notFollowedBy T.someSpace *> T.anyChar)) <* sseof + +-- | Grab a comment beginning with # and going to end of line. +hashComment :: T.DeltaParsing f => f Text +hashComment = toUtf8 (T.sliced (T.char '#' *> many (T.noneOf "\r\n"))) <* T.whiteSpace +-- hashComment = T.sliced (T.char '#' *> T.manyTill T.anyChar T.newline) <* T.whiteSpace + +-- | Choose by key in a map +parseMapKeys :: (T.TokenParsing f) + => (k -> String) + -> M.Map k v + -> f (k, v) +parseMapKeys ks m = T.choice $ (uncurry arm) <$> M.toList m + where + arm k v = ((T.try ((T.string $ ks k) <* sseof)) *> pure (k,v)) + T. show (ks k) + +