-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE CPP #-}
-- | Tracklang parsers.  Many of the parsers in here should be inverses of
-- the 'ShowVal.ShowVal' class.
module Derive.Parse (
    parse_expr
    , parse_val, parse_attrs, parse_num, parse_call
    , lex1, lex, split_pipeline, join_pipeline
    , unparsed_call

    -- * parsers
    , lexeme, p_pipe, p_expr, p_pcontrol_ref, p_identifier, p_symbol
    -- * expand macros
    , expand_macros
    -- * for Parse.Ky
    , p_val
    , p_unparsed_expr, p_null_call, p_single_quote_string
    , p_equal_generic
    , empty_line, spaces
#ifdef TESTING
    , module Derive.Parse
#endif
) where
import           Prelude hiding (lex)
import qualified Control.Applicative as A (many)
import qualified Control.Applicative as Applicative
import qualified Data.Attoparsec.Text as A
import           Data.Attoparsec.Text ((<?>))
import qualified Data.HashMap.Strict as HashMap
import qualified Data.IORef as IORef
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text

import qualified System.IO.Unsafe as Unsafe

import qualified Util.Lists as Lists
import qualified Util.ParseText as ParseText

import qualified Derive.Attrs as Attrs
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Expr as Expr
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Symbols as Symbols

import qualified Perform.Signal as Signal
import qualified Ui.Id as Id

import           Global


{- | Hacky memo table for 'parse_expr'.  There are many small exprs, and
    most of them are the the same, so we can save a lot of parsing time,
    and probably memory too since they will be interned.

    It would be more elegant and probably faster to put the memo directly in
    the Ui.Event, but this would introduce a giant dependency loop from
    low level Ui.Event up to DeriveT.Val.  At the least, it would go
    Ui.Event -> Events.Events -> Ui.State -> Ui.M -> Cmd.M, which means either
    a type parameter would have to propagate that far, or a SOURCE import would
    include that much.
-}
{-# NOINLINE memo_table #-}
memo_table :: IORef.IORef (HashMap Text (Either Text DeriveT.Expr))
memo_table :: IORef (HashMap Text (Either Text Expr))
memo_table = forall a. IO a -> a
Unsafe.unsafePerformIO (forall a. a -> IO (IORef a)
IORef.newIORef forall a. Monoid a => a
mempty)

parse_expr :: Text -> Either Text DeriveT.Expr
parse_expr :: Text -> Either Text Expr
parse_expr Text
str
    -- micro-optimize, but probably irrelevant
    | Text -> Bool
Text.null Text
str = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall val. Symbol -> Call val
Expr.call0 Symbol
"" forall a. a -> [a] -> NonEmpty a
:| []
    | Bool
otherwise = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
str HashMap Text (Either Text Expr)
table of
        Just Either Text Expr
expr -> Either Text Expr
expr
        Maybe (Either Text Expr)
Nothing -> (HashMap Text (Either Text Expr)
 -> HashMap Text (Either Text Expr))
-> ()
write (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
str Either Text Expr
expr) seq :: forall a b. a -> b -> b
`seq` Either Text Expr
expr
            where expr :: Either Text Expr
expr = Text -> Either Text Expr
parse_expr_raw Text
str
    where
    -- With concurrent access this can duplicate work, but since it's a cache
    -- that should be fine.  Also I don't do a strict modify, it probably makes
    -- no difference but the theory is to spend minimal time adding the entry,
    -- and the next call will force the thunk.
    table :: HashMap Text (Either Text Expr)
table = forall a. IO a -> a
Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
IORef.readIORef IORef (HashMap Text (Either Text Expr))
memo_table
    write :: (HashMap Text (Either Text Expr)
 -> HashMap Text (Either Text Expr))
-> ()
write = forall a. IO a -> a
Unsafe.unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef IORef (HashMap Text (Either Text Expr))
memo_table

{-# SCC parse_expr_raw #-}
parse_expr_raw :: Text -> Either Text DeriveT.Expr
parse_expr_raw :: Text -> Either Text Expr
parse_expr_raw = forall a. Parser a -> Text -> Either Text a
parse (Bool -> Parser Expr
p_expr Bool
True)

-- | Parse a single Val.
{-# SCC parse_val #-}
parse_val :: Text -> Either Text DeriveT.Val
parse_val :: Text -> Either Text Val
parse_val = forall a. Parser a -> Text -> Either Text a
ParseText.parse1 (forall a. Parser a -> Parser a
lexeme Parser Val
p_val)

-- | Parse attributes in the form +a+b.
parse_attrs :: String -> Either Text Attrs.Attributes
parse_attrs :: String -> Either Text Attributes
parse_attrs = forall a. Parser a -> Text -> Either Text a
parse Parser Attributes
p_attributes forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Parse a number or hex code, without a type suffix.
parse_num :: Text -> Either Text Signal.Y
parse_num :: Text -> Either Text Y
parse_num = forall a. Parser a -> Text -> Either Text a
ParseText.parse1 (forall a. Parser a -> Parser a
lexeme (Parser Text Y
p_hex forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Y
p_untyped_num))

-- | Extract only the call part of the text.
parse_call :: Text -> Maybe Text
parse_call :: Text -> Maybe Text
parse_call Text
text = case Text -> Either Text Expr
parse_expr_raw Text
text of
    Right Expr
expr -> case forall a. NonEmpty a -> a
NonEmpty.last Expr
expr of
        Expr.Call (Expr.Symbol Text
call) [Term Val]
_ -> forall a. a -> Maybe a
Just Text
call
    Either Text Expr
_ -> forall a. Maybe a
Nothing

parse :: A.Parser a -> Text -> Either Text a
parse :: forall a. Parser a -> Text -> Either Text a
parse Parser a
p = forall a. Parser a -> Text -> Either Text a
ParseText.parse1 (Parser ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p)

-- * lex

-- | Lex out a single expression.  This isn't really a traditional lex, because
-- it will extract a whole parenthesized expression instead of a token.  Also,
-- this leaves on trailing whitespace, so you can concatenate the lexed out
-- words and get the original input back.
lex1 :: Text -> (Text, Text)
lex1 :: Text -> (Text, Text)
lex1 Text
text = case forall a. Parser a -> Text -> Either Text a
parse ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
p_lex1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser Text
A.takeWhile (forall a b. a -> b -> a
const Bool
True)) Text
text of
    Right ((), Text
rest) ->
        (Int -> Text -> Text
Text.take (Text -> Int
Text.length Text
text forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
rest) Text
text, Text
rest)
    Left Text
_ -> (Text
text, Text
"")

-- | Like 'lex1', but get all of them.
lex :: Text -> [Text]
lex :: Text -> [Text]
lex Text
text
    | Text -> Bool
Text.null Text
pre = []
    | Text -> Bool
Text.null Text
post = [Text
pre]
    | Bool
otherwise = Text
pre forall a. a -> [a] -> [a]
: Text -> [Text]
lex Text
post
    where
    (Text
pre, Text
post) = Text -> (Text, Text)
lex1 Text
text

-- | Take an expression and lex it into words, where each sublist corresponds
-- to one expression in the pipeline.  Like 'lex1', this corresponds to call
-- name and arguments, not tokens.  The final word could be a comment.
--
-- This preserves trailing spaces on the words, because track editors use that
-- to infer edits in progress.
split_pipeline :: Text -> [[Text]]
split_pipeline :: Text -> [[Text]]
split_pipeline =
    forall a. (a -> a) -> [a] -> [a]
Lists.mapTail (forall a. Int -> [a] -> [a]
drop Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
Lists.splitBefore ((forall a. Eq a => a -> a -> Bool
==Text
"|") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lex

join_pipeline :: [[Text]] -> Text
join_pipeline :: [[Text]] -> Text
join_pipeline =
    forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
List.intercalate [Text
" | "] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> a) -> [a] -> [a]
Lists.mapLast Text -> Text
Text.stripEnd)

-- | This returns () on success and the caller will see how many chars were
-- consumed.  Attoparsec doesn't keep track of byte position, and always
-- backtracks.  I think this means I can't reuse 'p_term'.
p_lex1 :: A.Parser ()
p_lex1 :: Parser ()
p_lex1 =
    (Parser ()
str forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
parens forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser (Maybe Char)
p_equal_operator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
unparsed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
comment
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
word)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Char -> Bool) -> Parser ()
A.skipWhile Char -> Bool
is_whitespace)
    where
    str :: Parser ()
str = Parser Text
p_single_quote_string forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    parens :: Parser ()
parens = do
        Char -> Parser Char
A.char Char
'('
        forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many forall a b. (a -> b) -> a -> b
$ Parser ()
parens forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
str forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char -> Bool) -> Parser Text
A.takeWhile1 Char -> Bool
content_char forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
        Char -> Parser Char
A.char Char
')'
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    word :: Parser ()
word = (Char -> Bool) -> Parser ()
A.skipWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'(' Bool -> Bool -> Bool
&& Char -> Bool
is_word_char Char
c)
    content_char :: Char -> Bool
content_char Char
c = Char
c forall a. Eq a => a -> a -> Bool
/= Char
'(' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
')' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\''
    unparsed :: Parser ()
unparsed = Text -> Parser Text
A.string (Symbol -> Text
Expr.unsym Symbol
unparsed_call)
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
A.skipWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'|' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
')')
    comment :: Parser ()
comment = Text -> Parser Text
A.string Text
"--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
A.skipWhile (forall a b. a -> b -> a
const Bool
True)

-- * expand macros

-- | Map the identifiers after a \"\@\" through the given function.  Used
-- to implement ID macros for the REPL.
--
-- A macro looks like \@valid-id-chars.
expand_macros :: (Text -> Text) -> Text -> Either Text Text
expand_macros :: (Text -> Text) -> Text -> Either Text Text
expand_macros Text -> Text
replacement Text
text
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"@" Text -> Text -> Bool
`Text.isInfixOf` Text
text = forall a b. b -> Either a b
Right Text
text
    | Bool
otherwise = forall a. Parser a -> Text -> Either Text a
ParseText.parse1 ((Text -> Text) -> Parser Text
p_macros Text -> Text
replacement) Text
text

p_macros :: (Text -> Text) -> A.Parser Text
p_macros :: (Text -> Text) -> Parser Text
p_macros Text -> Text
replace = do
    [Text]
chunks <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Parser Text
p_macro Text -> Text
replace forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
p_chunk
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text
"\""<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<>Text
"\"") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
p_hs_string)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text]
chunks
    where
    p_chunk :: Parser Text
p_chunk = (Char -> Bool) -> Parser Text
A.takeWhile1 (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'@')

p_macro :: (Text -> Text) -> A.Parser Text
p_macro :: (Text -> Text) -> Parser Text
p_macro Text -> Text
replacement = do
    Char -> Parser Char
A.char Char
'@'
    Text -> Text
replacement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Text
unbackslash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
bare_string)
    where
    -- Strip escaped quotes, because 'show' will turn it back into haskell
    -- and re-add them.  This will mess up all the other zillion backslash
    -- features in haskell strings, but I probably won't use those.  'p_str'
    -- would be simpler, but since it's for the REPL, I feel like haskell-ish
    -- strings will be less error-prone.
    unbackslash :: Text -> Text
unbackslash = String -> Text
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
untxt
        where
        strip :: String -> String
strip (Char
'\\':Char
c:String
cs) = Char
c forall a. a -> [a] -> [a]
: String -> String
strip String
cs
        strip (Char
c:String
cs) = Char
c forall a. a -> [a] -> [a]
: String -> String
strip String
cs
        strip [] = []
    bare_string :: Parser Text
bare_string = (Char -> Bool) -> Parser Text
A.takeWhile1 (\Char
c -> Char -> Bool
Id.is_id_char Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/')

p_hs_string :: A.Parser Text
p_hs_string :: Parser Text
p_hs_string =
    forall x y a. Parser x -> Parser y -> Parser a -> Parser a
ParseText.between (Char -> Parser Char
A.char Char
'"') (Char -> Parser Char
A.char Char
'"') forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many Parser Text
chunk
    where
    chunk :: Parser Text
chunk = (Char -> Parser Char
A.char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Text -> Text
Text.cons Char
'\\' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text
A.take Int
1)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text
A.takeWhile1 (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\\')

-- * toplevel parsers

p_expr :: Bool -> A.Parser DeriveT.Expr
p_expr :: Bool -> Parser Expr
p_expr Bool
toplevel = do
    -- It definitely matches at least one, because p_null_call always matches.
    Call Val
c : [Call Val]
cs <- forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy1 (Bool -> Parser (Call Val)
p_toplevel_call Bool
toplevel) Parser ()
p_pipe
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Call Val
c forall a. a -> [a] -> NonEmpty a
:| [Call Val]
cs

-- | A toplevel call has a few special syntactic forms, other than the plain
-- @call arg arg ...@ form parsed by 'p_call'.
p_toplevel_call :: Bool -> A.Parser DeriveT.Call
p_toplevel_call :: Bool -> Parser (Call Val)
p_toplevel_call Bool
toplevel =
    Parser (Call Val)
p_unparsed_expr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Call Val)
p_equal forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser (Call Val)
p_call Bool
toplevel forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Parser (Call a)
p_null_call

-- | Parse a 'unparsed_call'.
p_unparsed_expr :: A.Parser DeriveT.Call
p_unparsed_expr :: Parser (Call Val)
p_unparsed_expr = do
    Text -> Parser Text
A.string forall a b. (a -> b) -> a -> b
$ Symbol -> Text
Expr.unsym Symbol
unparsed_call
    Text
text <- (Char -> Bool) -> Parser Text
A.takeWhile forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'|' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
')'
    let arg :: Str
arg = Text -> Str
Expr.Str forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip forall a b. (a -> b) -> a -> b
$ Text -> Text
strip_comment Text
text
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall val. Symbol -> [Term val] -> Call val
Expr.Call Symbol
unparsed_call [forall val. val -> Term val
Expr.Literal forall a b. (a -> b) -> a -> b
$ Str -> Val
DeriveT.VStr Str
arg]
    where
    -- Normally comments are considered whitespace by 'spaces_to_eol'.  Normal
    -- tokenization is suppressed for 'unparsed_call' so that doesn't happen,
    -- but I still want to allow comments, for consistency.
    strip_comment :: Text -> Text
strip_comment = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text.breakOn Text
"--"

-- | This is a magic call name that suppresses normal parsing.  Instead, the
-- rest of the event expression is passed as a string.  The only characters
-- that can't be used are ) and |, so an unparsed call can still be included in
-- a sub expression.
unparsed_call :: Expr.Symbol
unparsed_call :: Symbol
unparsed_call = Symbol
"!"

p_pipe :: A.Parser ()
p_pipe :: Parser ()
p_pipe = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Parser a
lexeme (Char -> Parser Char
A.char Char
'|')

p_equal :: A.Parser (Expr.Call DeriveT.Val)
p_equal :: Parser (Call Val)
p_equal = do
    (Str
lhs, Maybe Str
sym, [Term Val]
rhs) <- forall a. Parser a -> Parser (Str, Maybe Str, [a])
p_equal_generic (forall a. Parser a -> Parser a
lexeme Parser (Term Val)
p_term)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall val. Symbol -> [Term val] -> Call val
Expr.Call Symbol
Symbols.equal forall a b. (a -> b) -> a -> b
$
        Str -> Term Val
literal Str
lhs forall a. a -> [a] -> [a]
: [Term Val]
rhs forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) (Str -> Term Val
literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Str
sym)
    where literal :: Str -> Term Val
literal = forall val. val -> Term val
Expr.Literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> Val
DeriveT.VStr

p_equal_generic :: A.Parser a -> A.Parser (Expr.Str, Maybe Expr.Str, [a])
p_equal_generic :: forall a. Parser a -> Parser (Str, Maybe Str, [a])
p_equal_generic Parser a
rhs_term = do
    Text
lhs <- (Str -> Text
Expr.unstr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Str
p_str) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Symbol -> Text
Expr.unsym forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser Symbol
p_symbol Bool
True)
    Parser ()
spaces
    Maybe Char
mb_sym <- Parser (Maybe Char)
p_equal_operator
    Parser ()
spaces
    [a]
rhs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser a
rhs_term
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Str
Expr.Str Text
lhs, Text -> Str
Expr.Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
mb_sym, [a]
rhs)

p_equal_operator :: A.Parser (Maybe Char)
p_equal_operator :: Parser (Maybe Char)
p_equal_operator = Char -> Parser Char
A.char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Char -> Bool) -> Parser Char
A.satisfy (String -> Char -> Bool
A.inClass String
merge_symbols))

-- | Valid symbols after =.  This should correspond to the keys in
-- Equal.symbol_to_merge.  It could have more symbols, but then that syntax
-- becomes unavailable.  E.g. previously % was in the list, but then
-- @x=%control@ has to be written @x = %control@.
merge_symbols :: [Char]
merge_symbols :: String
merge_symbols = String
"-+*@"

p_call :: Bool -> A.Parser (Expr.Call DeriveT.Val)
p_call :: Bool -> Parser (Call Val)
p_call Bool
toplevel = forall val. Symbol -> [Term val] -> Call val
Expr.Call
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
lexeme (Bool -> Parser Symbol
p_symbol Bool
toplevel)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser a
lexeme (forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy Parser (Term Val)
p_term Parser ()
spaces1)

p_null_call :: A.Parser (Expr.Call a)
p_null_call :: forall a. Parser (Call a)
p_null_call = forall (m :: * -> *) a. Monad m => a -> m a
return (forall val. Symbol -> [Term val] -> Call val
Expr.Call Symbol
"" []) forall i a. Parser i a -> String -> Parser i a
<?> String
"null call"

-- | Any word in call position is considered a Str.  This means that
-- you can have calls like @4@ and @>@, which are useful names for notes or
-- ornaments.
p_symbol :: Bool -- ^ A call at the top level can allow a ).
    -> A.Parser Expr.Symbol
p_symbol :: Bool -> Parser Symbol
p_symbol Bool
toplevel = Text -> Symbol
Expr.Symbol forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser Text
p_word Bool
toplevel

p_term :: A.Parser (Expr.Term DeriveT.Val)
p_term :: Parser (Term Val)
p_term = forall val. val -> Term val
Expr.Literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Val
p_val forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall val. Call val -> Term val
Expr.ValCall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Call Val)
p_sub_call
    forall i a. Parser i a -> String -> Parser i a
<?> String
"term"

p_sub_call :: A.Parser (Expr.Call DeriveT.Val)
p_sub_call :: Parser (Call Val)
p_sub_call = forall x y a. Parser x -> Parser y -> Parser a -> Parser a
ParseText.between (Char -> Parser Char
A.char Char
'(') (Char -> Parser Char
A.char Char
')') (Bool -> Parser (Call Val)
p_call Bool
False)

p_val :: A.Parser DeriveT.Val
p_val :: Parser Val
p_val =
    Attributes -> Val
DeriveT.VAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Attributes
p_attributes
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Y -> Val
DeriveT.num forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Y
p_hex
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Typed Control -> Val
DeriveT.VSignal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (kind :: k). Y -> Signal kind
Signal.constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Typed Y)
p_num
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Str -> Val
DeriveT.VStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Str
p_str
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ControlRef -> Val
DeriveT.VControlRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ControlRef
p_control_ref
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PControlRef -> Val
DeriveT.VPControlRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PControlRef
p_pcontrol_ref
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Quoted -> Val
DeriveT.VQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Quoted
p_quoted
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
A.char Char
'_' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Val
DeriveT.VNotGiven)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
A.char Char
';' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Val
DeriveT.VSeparator)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Str -> Val
DeriveT.VStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Str
p_unquoted_str

p_num :: A.Parser (ScoreT.Typed Signal.Y)
p_num :: Parser (Typed Y)
p_num = do
    Y
num <- Parser Text Y
p_untyped_num
    let suffix :: (b, Text) -> Parser Text b
suffix (b
typ, Text
suf) = Text -> Parser Text
A.string Text
suf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b
typ
    Type
typ <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (b, Text) -> Parser Text b
suffix [(Type, Text)]
codes
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Type -> a -> Typed a
ScoreT.Typed Type
typ Y
num
    where
    codes :: [(Type, Text)]
codes = forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
ScoreT.all_types forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Type -> Text
ScoreT.type_to_code [Type]
ScoreT.all_types

p_untyped_num :: A.Parser Signal.Y
p_untyped_num :: Parser Text Y
p_untyped_num = Parser Text Y
p_ratio forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Y
ParseText.p_float
    -- It may seem as if this should include p_hex, but I don't want it
    -- for p_num, because none of the type codes make sense for a 0-1
    -- normalized value.

p_ratio :: A.Parser Signal.Y
p_ratio :: Parser Text Y
p_ratio = do
    Char
sign <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Char
'+' ((Char -> Bool) -> Parser Char
A.satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'))
    Int
num <- Parser Int
ParseText.p_nat
    Char -> Parser Char
A.char Char
'/'
    Int
denom <- Parser Int
ParseText.p_nat
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Char
sign forall a. Eq a => a -> a -> Bool
== Char
'-' then -Y
1 else Y
1)
        forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
denom

-- | Parse numbers of the form @`0x`00@ or @0x00@, with an optional @-@ prefix
-- for negation.
p_hex :: A.Parser Signal.Y
p_hex :: Parser Text Y
p_hex = do
    Y
sign <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Y
1 (Char -> Parser Char
A.char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Y
1))
    Text -> Parser Text
A.string Text
ShowVal.hex_prefix forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
A.string Text
"0x"
    let higit :: Char -> Bool
higit Char
c = Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' Bool -> Bool -> Bool
|| Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'f'
    Char
c1 <- (Char -> Bool) -> Parser Char
A.satisfy Char -> Bool
higit
    Char
c2 <- (Char -> Bool) -> Parser Char
A.satisfy Char -> Bool
higit
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Char -> Int
parse_hex Char
c1 Char
c2) forall a. Fractional a => a -> a -> a
/ Y
0xff forall a. Num a => a -> a -> a
* Y
sign

parse_hex :: Char -> Char -> Int
parse_hex :: Char -> Char -> Int
parse_hex Char
c1 Char
c2 = Char -> Int
higit Char
c1 forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ Char -> Int
higit Char
c2
    where
    higit :: Char -> Int
higit Char
c
        | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' = forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'0'
        | Bool
otherwise = forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'a' forall a. Num a => a -> a -> a
+ Int
10

-- | A string is anything between single quotes.  A single quote itself is
-- represented by two single quotes in a row.
p_str :: A.Parser Expr.Str
p_str :: Parser Str
p_str = Text -> Str
Expr.Str forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
p_single_quote_string

p_single_quote_string :: A.Parser Text
p_single_quote_string :: Parser Text
p_single_quote_string = do
    [Text]
chunks <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 forall a b. (a -> b) -> a -> b
$
        forall x y a. Parser x -> Parser y -> Parser a -> Parser a
ParseText.between (Char -> Parser Char
A.char Char
'\'') (Char -> Parser Char
A.char Char
'\'') ((Char -> Bool) -> Parser Text
A.takeTill (forall a. Eq a => a -> a -> Bool
==Char
'\''))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"'" [Text]
chunks

-- There's no particular reason to restrict attrs to idents, but this will
-- force some standardization on the names.
p_attributes :: A.Parser Attrs.Attributes
p_attributes :: Parser Attributes
p_attributes = Char -> Parser Char
A.char Char
'+'
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Text] -> Attributes
Attrs.attrs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy (Bool -> String -> Parser Text
p_identifier Bool
False String
"+") (Char -> Parser Char
A.char Char
'+'))

p_control_ref :: A.Parser DeriveT.ControlRef
p_control_ref :: Parser ControlRef
p_control_ref = do
    Char -> Parser Char
A.char Char
'%'
    Control
control <- Text -> Control
ScoreT.Control forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Text
"" (Bool -> String -> Parser Text
p_identifier Bool
False String
",")
    Maybe (Typed Y)
deflt <- forall a. Parser a -> Parser (Maybe a)
ParseText.optional (Char -> Parser Char
A.char Char
',' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Typed Y)
p_num)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall control val. control -> Maybe val -> Ref control val
DeriveT.Ref Control
control (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (kind :: k). Y -> Signal kind
Signal.constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Typed Y)
deflt)
    forall i a. Parser i a -> String -> Parser i a
<?> String
"control"

-- | Unlike 'p_control_ref', this doesn't parse a comma and a default value,
-- because pitches don't have literals.  Instead, use the @#@ val call.
p_pcontrol_ref :: A.Parser DeriveT.PControlRef
p_pcontrol_ref :: Parser PControlRef
p_pcontrol_ref = forall control val. control -> Maybe val -> Ref control val
DeriveT.Ref forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text PControl
p_pcontrol forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    where
    p_pcontrol :: Parser Text PControl
p_pcontrol = do
        Char -> Parser Char
A.char Char
'#'
        Text -> PControl
ScoreT.PControl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> Parser Text
p_identifier Bool
True String
""
        forall i a. Parser i a -> String -> Parser i a
<?> String
"pitch control"

p_quoted :: A.Parser DeriveT.Quoted
p_quoted :: Parser Quoted
p_quoted = forall x y a. Parser x -> Parser y -> Parser a -> Parser a
ParseText.between Parser Text
"\"(" Parser Text
")" (Expr -> Quoted
DeriveT.Quoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser Expr
p_expr Bool
False)

-- | Symbols can have anything in them but they have to start with a letter.
-- This means special literals can start with wacky characters and not be
-- ambiguous.
--
-- This should be a superset of what 'p_identifier' will accept, so if IDs use
-- 'p_identifier' and 'Id.valid_symbol', they will also be parseable without
-- quotes.
p_unquoted_str :: A.Parser Expr.Str
p_unquoted_str :: Parser Str
p_unquoted_str = do
    Text
sym <- Char -> Text -> Text
Text.cons
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
A.satisfy Char -> Bool
ShowVal.is_unquoted_head
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser Text
A.takeWhile Char -> Bool
is_word_char
    -- If I have an unbalanced quote, it may parse as an unquoted string with
    -- a quote in it, which is confusing.  So let's outlaw that.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"'" Text -> Text -> Bool
`Text.isInfixOf` Text
sym) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"quote in unquoted string: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
sym
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Str
Expr.Str Text
sym

-- | Identifiers are somewhat more strict than usual.  They must be lowercase,
-- and the only non-letter allowed is hyphen.  This means words must be
-- separated with hyphens, and leaves me free to give special meanings to
-- underscores or caps if I want.
--
-- @until@ gives additional chars that stop parsing, for idents that are
-- embedded in another lexeme.
p_identifier :: Bool -> String -> A.Parser Text
p_identifier :: Bool -> String -> Parser Text
p_identifier Bool
null_ok String
until = do
    -- TODO attoparsec docs say it's faster to do the check manually, profile
    -- and see if it makes a difference.
    Text
ident <- (if Bool
null_ok then (Char -> Bool) -> Parser Text
A.takeWhile else (Char -> Bool) -> Parser Text
A.takeWhile1)
        -- A.notInClass was buggy in old versions of attoparsec, and got
        -- turned into just an IntSet.
        -- (A.notInClass (until ++ " \n\t|=)")) -- buggy?
        (\Char
c -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
until Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t'
            Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'|' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
')')
        -- Newlines and tabs are forbidden from track and block titles and
        -- events, but can occur in ky files.
    -- This forces identifiers to be separated with spaces, except with | and
    -- =.  Otherwise @sym>inst@ is parsed as a call @sym >inst@, which I don't
    -- want to support.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Bool
null_ok Bool -> Bool -> Bool
&& Text -> Bool
Text.null Text
ident) Bool -> Bool -> Bool
|| Text -> Bool
Id.valid_symbol Text
ident) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid chars in identifier, expected "
            forall a. Semigroup a => a -> a -> a
<> Text -> String
untxt Text
Id.symbol_description forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
ident
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
ident

p_word :: Bool -> A.Parser Text
p_word :: Bool -> Parser Text
p_word Bool
toplevel =
    (Char -> Bool) -> Parser Text
A.takeWhile1 (if Bool
toplevel then Char -> Bool
is_toplevel_word_char else Char -> Bool
is_word_char)

-- | A word is as permissive as possible, and is terminated by whitespace.
-- That's because this determines how calls are allowed to be named, and for
-- expressiveness it's nice to use symbols.  For example, the slur call is just
-- @(@.
--
-- At the toplevel, any character is allowed except @=@, which lets me write
-- 'p_equal' expressions without spaces.  In sub calls, @)@ is not allowed,
-- because then I couldn't tell where the sub call expression ends, e.g. @())@.
-- However, @(()@ is fine, even though it looks weird.
--
-- I could get rid of the toplevel distinction by not allowing ) in calls
-- even at the toplevel, but I have @ly-(@ and @ly-)@ calls and I kind of like
-- how those look.  I guess it's a crummy justification, but no need to change
-- it unless toplevel gives more more trouble.
is_toplevel_word_char :: Char -> Bool
is_toplevel_word_char :: Char -> Bool
is_toplevel_word_char Char
c = Char -> Bool
ShowVal.is_unquoted_body Char
c
    Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
';' -- This is so the ; separator can appear anywhere.
    -- TODO remove it when I remove VSeparator

-- | Anything except whitespace, "=);"
is_word_char :: Char -> Bool
is_word_char :: Char -> Bool
is_word_char Char
c = Char -> Bool
is_toplevel_word_char Char
c Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
')'

lexeme :: A.Parser a -> A.Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaces)

-- | Skip spaces, including a newline as long as the next line, skipping empty
-- lines, is indented.
spaces :: A.Parser ()
spaces :: Parser ()
spaces = do
    Parser ()
spaces_to_eol
    forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option () forall a b. (a -> b) -> a -> b
$ do
        (Char -> Bool) -> Parser ()
A.skip (forall a. Eq a => a -> a -> Bool
==Char
'\n')
        forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany Parser ()
empty_line
        -- The next non-empty line has to be indented.
        (Char -> Bool) -> Parser ()
A.skip Char -> Bool
is_whitespace
        (Char -> Bool) -> Parser ()
A.skipWhile Char -> Bool
is_whitespace

-- | Like 'spaces', but require a space at the beginning.
spaces1 :: A.Parser ()
spaces1 :: Parser ()
spaces1 = Char -> Parser Char
A.char Char
' ' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
spaces

empty_line :: A.Parser ()
empty_line :: Parser ()
empty_line = Parser ()
spaces_to_eol forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser ()
A.skip (forall a. Eq a => a -> a -> Bool
==Char
'\n')

spaces_to_eol :: A.Parser ()
spaces_to_eol :: Parser ()
spaces_to_eol = do
    (Char -> Bool) -> Parser ()
A.skipWhile Char -> Bool
is_whitespace
    Text
comment <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Text
"" (Text -> Parser Text
A.string Text
"--")
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
Text.null Text
comment) forall a b. (a -> b) -> a -> b
$
        (Char -> Bool) -> Parser ()
A.skipWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')

is_whitespace :: Char -> Bool
is_whitespace :: Char -> Bool
is_whitespace Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t'

optional :: Applicative.Alternative f => f a -> f (Maybe a)
optional :: forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional = forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just