-
Notifications
You must be signed in to change notification settings - Fork 1
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Add a cmd quasiquoter #75
base: master
Are you sure you want to change the base?
Conversation
Fixes: #73 |
data StrSegment | ||
= StrText String | ||
| StrVar String | ||
deriving (Show, Eq) | ||
|
||
formatSpace :: String -> String | ||
formatSpace = foldr go "" | ||
where | ||
go x acc = x:if x == ' ' then dropWhile (' ' ==) acc else acc | ||
|
||
-- | Replace a newline by a space and convert multiple spaces to single space | ||
-- | ||
-- >>> :set -XQuasiQuotes | ||
-- >>> import Streamly.Internal.System | ||
-- >>> trim " abc \n bbb \n ccc " | ||
-- " abc bbb ccc " | ||
-- | ||
trim :: String -> String | ||
trim = formatSpace <$> (unwords . fmap formatSpace . lines) | ||
|
||
haskellIdentifier :: Monad m => Parser Char m String | ||
haskellIdentifier = | ||
let p = Parser.alphaNum <|> Parser.char '\'' <|> Parser.char '_' | ||
in Parser.some p Fold.toList | ||
|
||
strParser :: Monad m => Parser Char m [StrSegment] | ||
strParser = Parser.many content Fold.toList | ||
|
||
where | ||
|
||
plainText = StrText . trim <$> Parser.takeWhile1 (/= '#') Fold.toList | ||
escHash = StrText . (: []) <$> (Parser.char '#' *> Parser.char '#') | ||
lineCont = StrText [] <$ (Parser.char '#' *> Parser.char '\n') | ||
var = StrVar <$> | ||
( Parser.char '#' | ||
*> Parser.char '{' | ||
*> haskellIdentifier | ||
<* Parser.char '}' | ||
) | ||
plainHash = StrText . (: []) <$> Parser.char '#' | ||
|
||
-- order is important | ||
content = plainText <|> escHash <|> lineCont <|> var <|> plainHash | ||
|
||
strSegmentExp :: StrSegment -> Q Exp | ||
strSegmentExp (StrText text) = stringE text | ||
strSegmentExp (StrVar name) = do | ||
valueName <- lookupValueName name | ||
case valueName of | ||
Just vn -> varE vn | ||
Nothing -> | ||
fail | ||
$ "cmd quote: Haskell symbol `" ++ name | ||
++ "` is not in scope" | ||
|
||
strExp :: [StrSegment] -> Q Exp | ||
strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
You don't need all this. This is replicated.
formatSpace :: String -> String | ||
formatSpace = foldr go "" | ||
where | ||
go x acc = x:if x == ' ' then dropWhile (' ' ==) acc else acc | ||
|
||
-- | Replace a newline by a space and convert multiple spaces to single space | ||
-- | ||
-- >>> :set -XQuasiQuotes | ||
-- >>> import Streamly.Internal.System | ||
-- >>> trim " abc \n bbb \n ccc " | ||
-- " abc bbb ccc " | ||
-- | ||
trim :: String -> String | ||
trim = formatSpace <$> (unwords . fmap formatSpace . lines) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
You only need formatSpace
and trim
.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
We already have idiomatic code to do this:
-- | Replace newlines followed by any number of spaces with a single space.
oneLine :: String -> String
oneLine = unwords . fmap (dropWhile isSpace) . lines
|
||
expandVars :: String -> Q Exp | ||
expandVars ln = | ||
case runIdentity $ Stream.parse strParser (Stream.fromList ln) of |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
You can import strParser
from Unicode.String
. If not exported, you can export it internally.
After runIdentity
, you can use trim
and formatSpace
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Let's import as much as we can from streamly-core instead of writing it again.
Right x -> | ||
strExp x | ||
|
||
-- | A QuasiQuoter that treats the input as a string literal: |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
You'll need to change the documentation.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
You can point it to the str
documentation and add the doc for the changes that you made.
|
||
expandVars :: String -> Q Exp | ||
expandVars ln = | ||
case runIdentity $ Stream.parse strParser (Stream.fromList ln) of |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Let's import as much as we can from streamly-core instead of writing it again.
formatSpace :: String -> String | ||
formatSpace = foldr go "" | ||
where | ||
go x acc = x:if x == ' ' then dropWhile (' ' ==) acc else acc | ||
|
||
-- | Replace a newline by a space and convert multiple spaces to single space | ||
-- | ||
-- >>> :set -XQuasiQuotes | ||
-- >>> import Streamly.Internal.System | ||
-- >>> trim " abc \n bbb \n ccc " | ||
-- " abc bbb ccc " | ||
-- | ||
trim :: String -> String | ||
trim = formatSpace <$> (unwords . fmap formatSpace . lines) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
We already have idiomatic code to do this:
-- | Replace newlines followed by any number of spaces with a single space.
oneLine :: String -> String
oneLine = unwords . fmap (dropWhile isSpace) . lines
-- | ||
{-# LANGUAGE TemplateHaskell #-} | ||
|
||
module Streamly.Internal.System |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Put this in the command module rather than creating a new module.
No description provided.