-- Copyright 2022 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

{- | Parsing support for the "instrument:" section of the ky file.

    This is an awkward hybrid.  Firstly, the name is inconsistent, internally
    they are called "allocation" because "instrument" usually corresponds to
    'ScoreT.Instrument', while the allocation is the thing tying instrument
    to patch.  But at the UI level I find "allocation" too vague and use
    "instrument" for both concepts.

    But the main thing is that Allocation corresponds only to a subset of
    the actual 'Ui.UiConfig.Allocation'.  The real source of truth is
    UiConfig.Allocation.  So the ky equivalent has to merge in any changes
    that may have happened to the config (done in Parse.Ky.merge_instruments),
    which means automatically updating source, which is fiddly as usual.

    A more traditional and simpler way would be to make the ky source be the
    source of truth, but that would mean having it serialize all the fields.  I
    got pretty far down this route, but it got pretty complicated because
    there's a whole new expression language and serialization layer, and I
    become unsure if it was really a good idea.

    So we do complicated merging for now.
-}
module Derive.Parse.Instruments (
    Allocation(..)
    , Config(..), empty_config
    , Backend(..)
    , from_ui
    , instrument_section
    , update_ui
    -- * parse
    , p_allocation
    , unparse_allocations
    , spaces
) where
import qualified Data.Char as Char
import qualified Data.Text as Text

import qualified Util.Maps as Maps
import qualified Util.Num as Num
import qualified Util.P as P
import qualified Util.Parse as Parse
import qualified Util.Lists as Lists
import qualified Util.Texts as Texts

import qualified Derive.ScoreT as ScoreT
import qualified Instrument.Common as Common
import qualified Instrument.Inst as Inst
import qualified Instrument.InstT as InstT

import qualified Midi.Midi as Midi
import qualified Perform.Midi.Patch as Midi.Patch
import qualified Ui.UiConfig as UiConfig

import           Global


type Parser a = P.Parser a
type Error = Text

-- | This is a simplified subset of 'Ui.UiConfig.Allocation'.
data Allocation = Allocation {
    Allocation -> Instrument
alloc_name :: !ScoreT.Instrument
    , Allocation -> Qualified
alloc_qualified :: !InstT.Qualified
    , Allocation -> Config
alloc_config :: !Config
    , Allocation -> Backend
alloc_backend :: !Backend
    } deriving (Allocation -> Allocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Allocation -> Allocation -> Bool
$c/= :: Allocation -> Allocation -> Bool
== :: Allocation -> Allocation -> Bool
$c== :: Allocation -> Allocation -> Bool
Eq, Int -> Allocation -> ShowS
[Allocation] -> ShowS
Allocation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Allocation] -> ShowS
$cshowList :: [Allocation] -> ShowS
show :: Allocation -> [Char]
$cshow :: Allocation -> [Char]
showsPrec :: Int -> Allocation -> ShowS
$cshowsPrec :: Int -> Allocation -> ShowS
Show)

-- | Subset of 'Instrument.Common.Config'.
data Config = Config {
    Config -> Bool
config_mute :: !Bool
    , Config -> Bool
config_solo :: !Bool
    } deriving (Config -> Config -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> [Char]
$cshow :: Config -> [Char]
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

empty_config :: Config
empty_config :: Config
empty_config = Bool -> Bool -> Config
Config Bool
False Bool
False

data Backend = Midi Midi.WriteDevice [Midi.Channel] | NonMidi
    deriving (Backend -> Backend -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backend -> Backend -> Bool
$c/= :: Backend -> Backend -> Bool
== :: Backend -> Backend -> Bool
$c== :: Backend -> Backend -> Bool
Eq, Int -> Backend -> ShowS
[Backend] -> ShowS
Backend -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Backend] -> ShowS
$cshowList :: [Backend] -> ShowS
show :: Backend -> [Char]
$cshow :: Backend -> [Char]
showsPrec :: Int -> Backend -> ShowS
$cshowsPrec :: Int -> Backend -> ShowS
Show)

-- * instruments

instrument_section :: Text
instrument_section :: Text
instrument_section = Text
"instrument"

from_ui :: ScoreT.Instrument -> UiConfig.Allocation -> Either Error Allocation
from_ui :: Instrument -> Allocation -> Either Text Allocation
from_ui Instrument
inst Allocation
alloc = do
    Backend
backend <- case Allocation -> Backend
UiConfig.alloc_backend Allocation
alloc of
        UiConfig.Midi Config
config -> Config -> Either Text Backend
ui_midi Config
config
        Backend
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Backend
NonMidi
    let cconfig :: Config
cconfig = Allocation -> Config
UiConfig.alloc_config Allocation
alloc
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Allocation
        { alloc_name :: Instrument
alloc_name = Instrument
inst
        , alloc_qualified :: Qualified
alloc_qualified = Allocation -> Qualified
UiConfig.alloc_qualified Allocation
alloc
        , alloc_config :: Config
alloc_config = Config
            { config_mute :: Bool
config_mute = Config -> Bool
Common.config_mute Config
cconfig
            , config_solo :: Bool
config_solo = Config -> Bool
Common.config_solo Config
cconfig
            }
        , alloc_backend :: Backend
alloc_backend = Backend
backend
        }
    where
    ui_midi :: Midi.Patch.Config -> Either Error Backend
    ui_midi :: Config -> Either Text Backend
ui_midi Config
config =
        case forall a b. Ord a => [(a, b)] -> [(a, NonNull b)]
Lists.groupFst forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Config -> [((WriteDevice, Channel), Maybe Int)]
Midi.Patch.config_allocation Config
config of
            [(WriteDevice
wdev, NonNull Channel
chans)] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ WriteDevice -> NonNull Channel -> Backend
Midi WriteDevice
wdev NonNull Channel
chans
            [(WriteDevice, NonNull Channel)]
allocs -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"midi config too complicated for: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt [(WriteDevice, NonNull Channel)]
allocs

type LookupBackend = InstT.Qualified -> Maybe Inst.Backend

-- | Merge the Allocations parsed from the instrument section into the
-- Ui level config.
update_ui :: LookupBackend -> [Allocation]
    -> UiConfig.Allocations -> Either Error UiConfig.Allocations
update_ui :: LookupBackend
-> [Allocation] -> Allocations -> Either Text Allocations
update_ui LookupBackend
lookup_backend [Allocation]
allocs (UiConfig.Allocations Map Instrument Allocation
olds) = do
    Map Instrument Allocation
allocs <- forall {a} {b}. (a, [(Instrument, b)]) -> Either Text a
check forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> (Map k v, [(k, [v])])
Maps.unique2 forall a b. (a -> b) -> a -> b
$ forall a k. (a -> k) -> [a] -> [(k, a)]
Lists.keyOn Allocation -> Instrument
alloc_name [Allocation]
allocs
    [(Instrument, Allocation)]
inst_allocs <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM forall {t}.
(t, Paired Allocation Allocation)
-> Either Text (Maybe (t, Allocation))
inherit forall a b. (a -> b) -> a -> b
$ forall k v1 v2.
Ord k =>
Map k v1 -> Map k v2 -> [(k, Paired v1 v2)]
Maps.pairs Map Instrument Allocation
allocs Map Instrument Allocation
olds
    LookupBackend
-> Allocations
-> [(Instrument, Allocation)]
-> Either Text Allocations
add_allocations LookupBackend
lookup_backend forall a. Monoid a => a
mempty [(Instrument, Allocation)]
inst_allocs
    where
    check :: (a, [(Instrument, b)]) -> Either Text a
check (a
m, []) = forall (m :: * -> *) a. Monad m => a -> m a
return a
m
    check (a
_, [(Instrument, b)]
dups) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"duplicate names: "
        forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unwords (forall a b. (a -> b) -> [a] -> [b]
map (Instrument -> Text
ScoreT.instrument_name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Instrument, b)]
dups)
    -- Since a parsed Allocation doesn't have all possible data, inherit
    -- the rest from an already existing allocation with this name.
    inherit :: (t, Paired Allocation Allocation)
-> Either Text (Maybe (t, Allocation))
inherit = \case
        (t
inst, Lists.Both Allocation
alloc Allocation
old) ->
            forall a. a -> Maybe a
Just  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t
inst,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LookupBackend
-> Allocation -> Maybe Allocation -> Either Text Allocation
to_ui LookupBackend
lookup_backend Allocation
alloc (forall a. a -> Maybe a
Just Allocation
old)
        (t
inst, Lists.First Allocation
alloc) ->
            forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t
inst,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LookupBackend
-> Allocation -> Maybe Allocation -> Either Text Allocation
to_ui LookupBackend
lookup_backend Allocation
alloc forall a. Maybe a
Nothing
        (t
_, Lists.Second Allocation
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

add_allocations :: LookupBackend
    -> UiConfig.Allocations -> [(ScoreT.Instrument, UiConfig.Allocation)]
    -> Either Error UiConfig.Allocations
add_allocations :: LookupBackend
-> Allocations
-> [(Instrument, Allocation)]
-> Either Text Allocations
add_allocations LookupBackend
lookup_backend = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Allocations -> (Instrument, Allocation) -> Either Text Allocations
add
    where
    add :: Allocations -> (Instrument, Allocation) -> Either Text Allocations
add Allocations
allocs (Instrument
inst, Allocation
alloc) = do
        let qual :: Qualified
qual = Allocation -> Qualified
UiConfig.alloc_qualified Allocation
alloc
        Backend
backend <- forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
tryJust (Text
"patch not found: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Qualified
qual) forall a b. (a -> b) -> a -> b
$
            LookupBackend
lookup_backend Qualified
qual
        Backend
-> Instrument
-> Allocation
-> Allocations
-> Either Text Allocations
UiConfig.allocate Backend
backend Instrument
inst Allocation
alloc Allocations
allocs

to_ui :: LookupBackend -> Allocation -> Maybe UiConfig.Allocation
    -> Either Error UiConfig.Allocation
to_ui :: LookupBackend
-> Allocation -> Maybe Allocation -> Either Text Allocation
to_ui LookupBackend
lookup_backend (Allocation Instrument
_name Qualified
qual (Config Bool
mute Bool
solo) Backend
backend) Maybe Allocation
old = do
    Backend
ui_backend <- case (Backend
backend, Allocation -> Backend
UiConfig.alloc_backend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Allocation
old) of
        (Midi WriteDevice
wdev NonNull Channel
chans, Just (UiConfig.Midi Config
config)) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            Config -> Backend
UiConfig.Midi forall a b. (a -> b) -> a -> b
$ Config
config
                { config_allocation :: [((WriteDevice, Channel), Maybe Int)]
Midi.Patch.config_allocation =
                    [((WriteDevice
wdev, Channel
chan), forall a. Maybe a
Nothing) | Channel
chan <- NonNull Channel
chans]
                }
        (Midi WriteDevice
wdev NonNull Channel
chans, Maybe Backend
Nothing) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            Config -> Backend
UiConfig.Midi forall a b. (a -> b) -> a -> b
$ [((WriteDevice, Channel), Maybe Int)] -> Config
Midi.Patch.config
                [((WriteDevice
wdev, Channel
chan), forall a. Maybe a
Nothing) | Channel
chan <- NonNull Channel
chans]
        (Midi {}, Just Backend
backend) ->
            forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"tried to turn into midi: " forall a. Semigroup a => a -> a -> a
<> Backend -> Text
UiConfig.backend_name Backend
backend
        (Backend
NonMidi, Just (UiConfig.Midi {})) -> forall a b. a -> Either a b
Left Text
"midi inst with no channels"
        (Backend
NonMidi, Just Backend
backend) -> forall (m :: * -> *) a. Monad m => a -> m a
return Backend
backend
        (Backend
NonMidi, Maybe Backend
Nothing) -> case LookupBackend
lookup_backend Qualified
qual of
            Maybe Backend
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"patch not found: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Qualified
qual
            Just Backend
backend -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Backend -> Backend
UiConfig.convert_backend Backend
backend
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UiConfig.Allocation
        { alloc_qualified :: Qualified
alloc_qualified = Qualified
qual
        , alloc_config :: Config
alloc_config = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Config
Common.empty_config Allocation -> Config
UiConfig.alloc_config Maybe Allocation
old)
            { config_mute :: Bool
Common.config_mute = Bool
mute
            , config_solo :: Bool
Common.config_solo = Bool
solo
            }
        , alloc_backend :: Backend
alloc_backend = Backend
ui_backend
        }

-- * parse / unparse

p_allocation :: Parser Allocation
p_allocation :: Parser Allocation
p_allocation = Instrument -> Qualified -> Config -> Backend -> Allocation
Allocation
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
">" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Instrument
ScoreT.Instrument forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ParsecT Void Text Identity Text
p_word [Char]
""))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser a
lexeme (Text -> Qualified
InstT.parse_qualified forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ParsecT Void Text Identity Text
p_word [Char]
"/")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser a
lexeme Parser Config
p_config
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Backend
p_backend

type Comment = Text

unparse_allocations :: [(Maybe Allocation, Comment)] -> [Text]
unparse_allocations :: [(Maybe Allocation, Text)] -> [Text]
unparse_allocations [(Maybe Allocation, Text)]
allocs = Int -> [Either Text [Text]] -> [Text]
Texts.columnsSome Int
1
    [ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Text
cmt) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++[Text]
cmts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Allocation -> [Text]
un_allocation) Maybe Allocation
mb_alloc
    | (Maybe Allocation
mb_alloc, Text
cmt) <- [(Maybe Allocation, Text)]
allocs
    , let cmts :: [Text]
cmts = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
"") [Text
cmt]
    ]

un_allocation :: Allocation -> [Text]
un_allocation :: Allocation -> [Text]
un_allocation (Allocation Instrument
name Qualified
qualified Config
config Backend
backend) =
    [ Text
">" forall a. Semigroup a => a -> a -> a
<> Instrument -> Text
ScoreT.instrument_name Instrument
name
    , Qualified -> Text
InstT.show_qualified Qualified
qualified
    , Config -> Text
un_config Config
config
    , Backend -> Text
un_backend Backend
backend
    ]

p_config :: Parser Config
p_config :: Parser Config
p_config = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Config
empty_config forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
']') forall a b. (a -> b) -> a -> b
$
    forall {t :: * -> *} {m :: * -> *}.
(Foldable t, MonadFail m, Show (t Char)) =>
t Char -> m Config
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
untxt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Tokens s)
P.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
']')
    where
    check :: t Char -> m Config
check t Char
cs
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'm', Char
's']) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
Char.toLower) t Char
cs =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config
                { config_mute :: Bool
config_mute = Char
'M' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
cs
                , config_solo :: Bool
config_solo = Char
'S' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
cs
                }
        | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"flags must be [MSms]: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show t Char
cs

un_config :: Config -> Text
un_config :: Config -> Text
un_config (Config Bool
mute Bool
solo) =
    Text
"[" forall a. Semigroup a => a -> a -> a
<> (if Bool
mute then Text
"M" else Text
"m") forall a. Semigroup a => a -> a -> a
<> (if Bool
solo then Text
"S" else Text
"s") forall a. Semigroup a => a -> a -> a
<> Text
"]"

p_backend :: Parser Backend
p_backend :: Parser Backend
p_backend =
    WriteDevice -> NonNull Channel -> Backend
Midi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
lexeme (Text -> WriteDevice
Midi.write_device forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ParsecT Void Text Identity Text
p_word [Char]
"")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some (forall a. Parser a -> Parser a
lexeme forall {m :: * -> *}. ParsecT Void Text m Channel
p_chan)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Backend
NonMidi
    where
    p_chan :: ParsecT Void Text m Channel
p_chan = do
        Int
chan <- forall (m :: * -> *). ParserT m Int
Parse.p_nat
        if forall a. Ord a => a -> a -> a -> Bool
Num.inRange Int
1 Int
17 Int
chan then 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 (Int
chan forall a. Num a => a -> a -> a
- Int
1)
            else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"midi channel should be in range 1--16: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
chan

un_backend :: Backend -> Text
un_backend :: Backend -> Text
un_backend = \case
    Midi WriteDevice
wdev NonNull Channel
chans ->
        [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ WriteDevice -> Text
Midi.write_device_text WriteDevice
wdev forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> Text
showt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Channel
1)) NonNull Channel
chans
    Backend
NonMidi -> Text
""

-- * util

p_word :: [Char] -> Parser Text
p_word :: [Char] -> ParsecT Void Text Identity Text
p_word [Char]
extra = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Tokens s)
P.takeWhile1 forall a b. (a -> b) -> a -> b
$ \Token Text
c -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$Token Text
c)
    [ Char -> Bool
Char.isAsciiLower, Char -> Bool
Char.isAsciiUpper, Char -> Bool
Char.isDigit
    , (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"-" :: [Char]))
    , (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
extra)
    ]

spaces :: Parser ()
spaces :: Parser ()
spaces = forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipMany forall a b. (a -> b) -> a -> b
$
    (ParsecT Void Text Identity Text
"--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m ()
P.skipWhile (forall a. Eq a => a -> a -> Bool
/=Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m ()
P.skipWhile (forall a. Eq a => a -> a -> Bool
==Char
'\n'))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipSome (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'\n')

lexeme :: Parser 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)