{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-unused-do-bind #-}

module Sound.Tidal.ParseBP where

{-
    ParseBP.hs - Parser for Tidal's "mini-notation", inspired by
      Bernard Bel's BP2 (Bol Processor 2) system.
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Control.Applicative ()
import qualified Control.Exception as E
import Data.Bifunctor (first)
import Data.Colour
import Data.Colour.Names
import Data.Functor (($>))
import Data.Functor.Identity (Identity)
import Data.List (intercalate)
import Data.Maybe
import Data.Ratio
import Data.Typeable (Typeable)
import GHC.Exts (IsString (..))
import Sound.Tidal.Chords
import Sound.Tidal.Core
import Sound.Tidal.Pattern hiding ((*>), (<*))
import Sound.Tidal.UI
import Sound.Tidal.Utils (fromRight)
import Text.Parsec.Error
import qualified Text.Parsec.Prim
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language (haskellDef)
import qualified Text.ParserCombinators.Parsec.Token as P

data TidalParseError = TidalParseError
  { TidalParseError -> ParseError
parsecError :: ParseError,
    TidalParseError -> String
code :: String
  }
  deriving (TidalParseError -> TidalParseError -> Bool
(TidalParseError -> TidalParseError -> Bool)
-> (TidalParseError -> TidalParseError -> Bool)
-> Eq TidalParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TidalParseError -> TidalParseError -> Bool
== :: TidalParseError -> TidalParseError -> Bool
$c/= :: TidalParseError -> TidalParseError -> Bool
/= :: TidalParseError -> TidalParseError -> Bool
Eq, Typeable)

instance E.Exception TidalParseError

instance Show TidalParseError where
  show :: TidalParseError -> String
show TidalParseError
err = String
"Syntax error in sequence:\n  \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TidalParseError -> String
code TidalParseError
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pointer String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message
    where
      pointer :: String
pointer = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (SourcePos -> Int
sourceColumn (SourcePos -> Int) -> SourcePos -> Int
forall a b. (a -> b) -> a -> b
$ ParseError -> SourcePos
errorPos ParseError
perr) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^"
      message :: String
message = String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of input" ([Message] -> String) -> [Message] -> String
forall a b. (a -> b) -> a -> b
$ ParseError -> [Message]
errorMessages ParseError
perr
      perr :: ParseError
perr = TidalParseError -> ParseError
parsecError TidalParseError
err

type MyParser = Text.Parsec.Prim.Parsec String Int

-- | AST representation of patterns
data TPat a where
  TPat_Atom :: (Maybe ((Int, Int), (Int, Int))) -> a -> TPat a
  TPat_Fast :: (TPat Time) -> (TPat a) -> TPat a
  TPat_Slow :: (TPat Time) -> (TPat a) -> TPat a
  TPat_DegradeBy :: Int -> Double -> (TPat a) -> TPat a
  TPat_CycleChoose :: Int -> [TPat a] -> TPat a
  TPat_Euclid :: (TPat Int) -> (TPat Int) -> (TPat Int) -> (TPat a) -> TPat a
  TPat_Stack :: [TPat a] -> TPat a
  TPat_Polyrhythm :: (Maybe (TPat Rational)) -> [TPat a] -> TPat a
  TPat_Seq :: [TPat a] -> TPat a
  TPat_Silence :: TPat a
  TPat_Foot :: TPat a
  TPat_Elongate :: Rational -> (TPat a) -> TPat a
  TPat_Repeat :: Int -> (TPat a) -> TPat a
  TPat_EnumFromTo :: (TPat a) -> (TPat a) -> TPat a
  TPat_Var :: String -> TPat a
  TPat_Chord :: (Num b, Enum b, Parseable b, Enumerable b) => (b -> a) -> (TPat b) -> (TPat String) -> [TPat [Modifier]] -> TPat a

instance (Show a) => Show (TPat a) where
  show :: TPat a -> String
show (TPat_Atom Maybe ((Int, Int), (Int, Int))
c a
v) = String
"TPat_Atom (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe ((Int, Int), (Int, Int)) -> String
forall a. Show a => a -> String
show Maybe ((Int, Int), (Int, Int))
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Fast TPat Rational
t TPat a
v) = String
"TPat_Fast (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Rational -> String
forall a. Show a => a -> String
show TPat Rational
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Slow TPat Rational
t TPat a
v) = String
"TPat_Slow (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Rational -> String
forall a. Show a => a -> String
show TPat Rational
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_DegradeBy Int
x Double
r TPat a
v) = String
"TPat_DegradeBy (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_CycleChoose Int
x [TPat a]
vs) = String
"TPat_CycleChoose (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => a -> String
show [TPat a]
vs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Euclid TPat Int
a TPat Int
b TPat Int
c TPat a
v) = String
"TPat_Euclid (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Int -> String
forall a. Show a => a -> String
show TPat Int
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Int -> String
forall a. Show a => a -> String
show TPat Int
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Int -> String
forall a. Show a => a -> String
show TPat Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Stack [TPat a]
vs) = String
"TPat_Stack " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => a -> String
show [TPat a]
vs
  show (TPat_Polyrhythm Maybe (TPat Rational)
mSteprate [TPat a]
vs) = String
"TPat_Polyrhythm (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (TPat Rational) -> String
forall a. Show a => a -> String
show Maybe (TPat Rational)
mSteprate String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => a -> String
show [TPat a]
vs
  show (TPat_Seq [TPat a]
vs) = String
"TPat_Seq " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => a -> String
show [TPat a]
vs
  show TPat a
TPat_Silence = String
"TPat_Silence"
  show TPat a
TPat_Foot = String
"TPat_Foot"
  show (TPat_Elongate Rational
r TPat a
v) = String
"TPat_Elongate (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Repeat Int
r TPat a
v) = String
"TPat_Repeat (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_EnumFromTo TPat a
a TPat a
b) = String
"TPat_EnumFromTo (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Var String
s) = String
"TPat_Var " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
  show (TPat_Chord b -> a
g TPat b
iP TPat String
nP [TPat [Modifier]]
msP) = String
"TPat_Chord (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (TPat a -> String
forall a. Show a => a -> String
show (TPat a -> String) -> TPat a -> String
forall a b. (a -> b) -> a -> b
$ (b -> a) -> TPat b -> TPat a
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
g TPat b
iP) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat String -> String
forall a. Show a => a -> String
show TPat String
nP String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat [Modifier]] -> String
forall a. Show a => a -> String
show [TPat [Modifier]]
msP String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Functor TPat where
  fmap :: forall a b. (a -> b) -> TPat a -> TPat b
fmap a -> b
f (TPat_Atom Maybe ((Int, Int), (Int, Int))
c a
v) = Maybe ((Int, Int), (Int, Int)) -> b -> TPat b
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
c (a -> b
f a
v)
  fmap a -> b
f (TPat_Fast TPat Rational
t TPat a
v) = TPat Rational -> TPat b -> TPat b
forall a. TPat Rational -> TPat a -> TPat a
TPat_Fast TPat Rational
t ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
v)
  fmap a -> b
f (TPat_Slow TPat Rational
t TPat a
v) = TPat Rational -> TPat b -> TPat b
forall a. TPat Rational -> TPat a -> TPat a
TPat_Slow TPat Rational
t ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
v)
  fmap a -> b
f (TPat_DegradeBy Int
x Double
r TPat a
v) = Int -> Double -> TPat b -> TPat b
forall a. Int -> Double -> TPat a -> TPat a
TPat_DegradeBy Int
x Double
r ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
v)
  fmap a -> b
f (TPat_CycleChoose Int
x [TPat a]
vs) = Int -> [TPat b] -> TPat b
forall a. Int -> [TPat a] -> TPat a
TPat_CycleChoose Int
x ((TPat a -> TPat b) -> [TPat a] -> [TPat b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [TPat a]
vs)
  fmap a -> b
f (TPat_Euclid TPat Int
a TPat Int
b TPat Int
c TPat a
v) = TPat Int -> TPat Int -> TPat Int -> TPat b -> TPat b
forall a. TPat Int -> TPat Int -> TPat Int -> TPat a -> TPat a
TPat_Euclid TPat Int
a TPat Int
b TPat Int
c ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
v)
  fmap a -> b
f (TPat_Stack [TPat a]
vs) = [TPat b] -> TPat b
forall a. [TPat a] -> TPat a
TPat_Stack ((TPat a -> TPat b) -> [TPat a] -> [TPat b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [TPat a]
vs)
  fmap a -> b
f (TPat_Polyrhythm Maybe (TPat Rational)
mSteprate [TPat a]
vs) = Maybe (TPat Rational) -> [TPat b] -> TPat b
forall a. Maybe (TPat Rational) -> [TPat a] -> TPat a
TPat_Polyrhythm Maybe (TPat Rational)
mSteprate ((TPat a -> TPat b) -> [TPat a] -> [TPat b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [TPat a]
vs)
  fmap a -> b
f (TPat_Seq [TPat a]
vs) = [TPat b] -> TPat b
forall a. [TPat a] -> TPat a
TPat_Seq ((TPat a -> TPat b) -> [TPat a] -> [TPat b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [TPat a]
vs)
  fmap a -> b
_ TPat a
TPat_Silence = TPat b
forall a. TPat a
TPat_Silence
  fmap a -> b
_ TPat a
TPat_Foot = TPat b
forall a. TPat a
TPat_Foot
  fmap a -> b
f (TPat_Elongate Rational
r TPat a
v) = Rational -> TPat b -> TPat b
forall a. Rational -> TPat a -> TPat a
TPat_Elongate Rational
r ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
v)
  fmap a -> b
f (TPat_Repeat Int
r TPat a
v) = Int -> TPat b -> TPat b
forall a. Int -> TPat a -> TPat a
TPat_Repeat Int
r ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
v)
  fmap a -> b
f (TPat_EnumFromTo TPat a
a TPat a
b) = TPat b -> TPat b -> TPat b
forall a. TPat a -> TPat a -> TPat a
TPat_EnumFromTo ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
a) ((a -> b) -> TPat a -> TPat b
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
b)
  fmap a -> b
_ (TPat_Var String
s) = String -> TPat b
forall a. String -> TPat a
TPat_Var String
s
  fmap a -> b
f (TPat_Chord b -> a
g TPat b
iP TPat String
nP [TPat [Modifier]]
msP) = (b -> b) -> TPat b -> TPat String -> [TPat [Modifier]] -> TPat b
forall b a.
(Num b, Enum b, Parseable b, Enumerable b) =>
(b -> a) -> TPat b -> TPat String -> [TPat [Modifier]] -> TPat a
TPat_Chord (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g) TPat b
iP TPat String
nP [TPat [Modifier]]
msP

tShowList :: (Show a) => [TPat a] -> String
tShowList :: forall a. Show a => [TPat a] -> String
tShowList [TPat a]
vs = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((TPat a -> String) -> [TPat a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TPat a -> String
forall a. Show a => TPat a -> String
tShow [TPat a]
vs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

tShow :: (Show a) => TPat a -> String
tShow :: forall a. Show a => TPat a -> String
tShow (TPat_Atom Maybe ((Int, Int), (Int, Int))
_ a
v) = String
"pure " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v
tShow (TPat_Fast TPat Rational
t TPat a
v) = String
"fast " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Rational -> String
forall a. Show a => a -> String
show TPat Rational
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
tShow (TPat_Slow TPat Rational
t TPat a
v) = String
"slow " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Rational -> String
forall a. Show a => a -> String
show TPat Rational
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
-- TODO - should be _degradeByUsing, but needs a simplified version..
tShow (TPat_DegradeBy Int
_ Double
r TPat a
v) = String
"degradeBy " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
-- TODO - ditto
tShow (TPat_CycleChoose Int
_ [TPat a]
vs) = String
"cycleChoose " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => [TPat a] -> String
tShowList [TPat a]
vs
tShow (TPat_Euclid TPat Int
a TPat Int
b TPat Int
c TPat a
v) = String
"doEuclid (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
") (" ((TPat Int -> String) -> [TPat Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TPat Int -> String
forall a. Show a => TPat a -> String
tShow [TPat Int
a, TPat Int
b, TPat Int
c]) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
tShow (TPat_Stack [TPat a]
vs) = String
"stack " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => [TPat a] -> String
tShowList [TPat a]
vs
tShow (TPat_Polyrhythm Maybe (TPat Rational)
mSteprate [TPat a]
vs) = String
"stack [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((Rational, String) -> String) -> [(Rational, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Rational, String) -> String
forall {a}. Show a => (a, String) -> String
adjust_speed [(Rational, String)]
pats) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
  where
    adjust_speed :: (a, String) -> String
adjust_speed (a
sz, String
pat) = String
"(fast (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String
steprate String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
sz) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pat String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    steprate :: String
    steprate :: String
steprate = String
-> (TPat Rational -> String) -> Maybe (TPat Rational) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
base_first TPat Rational -> String
forall a. Show a => TPat a -> String
tShow Maybe (TPat Rational)
mSteprate
    base_first :: String
base_first
      | [(Rational, String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Rational, String)]
pats = String
"0"
      | Bool
otherwise = Rational -> String
forall a. Show a => a -> String
show (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ (Rational, String) -> Rational
forall a b. (a, b) -> a
fst ((Rational, String) -> Rational) -> (Rational, String) -> Rational
forall a b. (a -> b) -> a -> b
$ [(Rational, String)] -> (Rational, String)
forall a. HasCallStack => [a] -> a
head [(Rational, String)]
pats
    pats :: [(Rational, String)]
pats = (TPat a -> (Rational, String)) -> [TPat a] -> [(Rational, String)]
forall a b. (a -> b) -> [a] -> [b]
map TPat a -> (Rational, String)
forall a. Show a => TPat a -> (Rational, String)
steps_tpat [TPat a]
vs
tShow (TPat_Seq [TPat a]
vs) = (Rational, String) -> String
forall a b. (a, b) -> b
snd ((Rational, String) -> String) -> (Rational, String) -> String
forall a b. (a -> b) -> a -> b
$ [TPat a] -> (Rational, String)
forall a. Show a => [TPat a] -> (Rational, String)
steps_seq [TPat a]
vs
tShow TPat a
TPat_Silence = String
"silence"
tShow (TPat_EnumFromTo TPat a
a TPat a
b) = String
"unwrap $ fromTo <$> (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") <*> (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
tShow (TPat_Var String
s) = String
"getControl " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
tShow (TPat_Chord b -> a
f TPat b
n TPat String
name [TPat [Modifier]]
mods) = String
"chord (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (TPat a -> String
forall a. Show a => TPat a -> String
tShow (TPat a -> String) -> TPat a -> String
forall a b. (a -> b) -> a -> b
$ (b -> a) -> TPat b -> TPat a
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f TPat b
n) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat String -> String
forall a. Show a => TPat a -> String
tShow TPat String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat [Modifier]] -> String
forall a. Show a => [TPat a] -> String
tShowList [TPat [Modifier]]
mods
tShow TPat a
a = String
"can't happen? " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
a

toPat :: (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat :: forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat = \case
  TPat_Atom (Just ((Int, Int), (Int, Int))
loc) a
x -> Context -> Pattern a -> Pattern a
forall a. Context -> Pattern a -> Pattern a
setContext ([((Int, Int), (Int, Int))] -> Context
Context [((Int, Int), (Int, Int))
loc]) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  TPat_Atom Maybe ((Int, Int), (Int, Int))
Nothing a
x -> a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  TPat_Fast TPat Rational
t TPat a
x -> Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
fast (TPat Rational -> Pattern Rational
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Rational
t) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
x
  TPat_Slow TPat Rational
t TPat a
x -> Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
slow (TPat Rational -> Pattern Rational
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Rational
t) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
x
  TPat_DegradeBy Int
seed Double
amt TPat a
x -> Pattern Double -> Double -> Pattern a -> Pattern a
forall a. Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing (Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
rotL (Rational
0.0001 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seed) Pattern Double
forall a. Fractional a => Pattern a
rand) Double
amt (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
x
  TPat_CycleChoose Int
seed [TPat a]
xs -> Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern Rational -> Pattern (Pattern a) -> Pattern (Pattern a)
forall a. Pattern Rational -> Pattern a -> Pattern a
segment Pattern Rational
1 (Pattern (Pattern a) -> Pattern (Pattern a))
-> Pattern (Pattern a) -> Pattern (Pattern a)
forall a b. (a -> b) -> a -> b
$ Pattern Double -> [Pattern a] -> Pattern (Pattern a)
forall a. Pattern Double -> [a] -> Pattern a
chooseBy (Rational -> Pattern Double -> Pattern Double
forall a. Rational -> Pattern a -> Pattern a
rotL (Rational
0.0001 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seed) Pattern Double
forall a. Fractional a => Pattern a
rand) ([Pattern a] -> Pattern (Pattern a))
-> [Pattern a] -> Pattern (Pattern a)
forall a b. (a -> b) -> a -> b
$ (TPat a -> Pattern a) -> [TPat a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat [TPat a]
xs
  TPat_Euclid TPat Int
n TPat Int
k TPat Int
s TPat a
thing -> Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
forall a.
Parseable a =>
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
doEuclid (TPat Int -> Pattern Int
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
n) (TPat Int -> Pattern Int
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
k) (TPat Int -> Pattern Int
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
s) (TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
thing)
  TPat_Stack [TPat a]
xs -> [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (TPat a -> Pattern a) -> [TPat a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat [TPat a]
xs
  TPat a
TPat_Silence -> Pattern a
forall a. Pattern a
silence
  TPat_EnumFromTo TPat a
a TPat a
b -> Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ a -> a -> Pattern a
forall a. Enumerable a => a -> a -> Pattern a
fromTo (a -> a -> Pattern a) -> Pattern a -> Pattern (a -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
a Pattern (a -> Pattern a) -> Pattern a -> Pattern (Pattern a)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
b
  TPat a
TPat_Foot -> String -> Pattern a
forall a. HasCallStack => String -> a
error String
"Can't happen, feet are pre-processed."
  TPat_Polyrhythm Maybe (TPat Rational)
mSteprate [TPat a]
ps -> [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((Rational, Pattern a) -> Pattern a)
-> [(Rational, Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (Rational, Pattern a) -> Pattern a
forall {a}. (Rational, Pattern a) -> Pattern a
adjust_speed [(Rational, Pattern a)]
pats
    where
      adjust_speed :: (Rational, Pattern a) -> Pattern a
adjust_speed (Rational
sz, Pattern a
pat) = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
fast ((Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
sz) (Rational -> Rational) -> Pattern Rational -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
steprate) Pattern a
pat
      pats :: [(Rational, Pattern a)]
pats = (TPat a -> (Rational, Pattern a))
-> [TPat a] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map TPat a -> (Rational, Pattern a)
forall a.
(Enumerable a, Parseable a) =>
TPat a -> (Rational, Pattern a)
resolve_tpat [TPat a]
ps
      steprate :: Pattern Rational
      steprate :: Pattern Rational
steprate = (Pattern Rational
-> (TPat Rational -> Pattern Rational)
-> Maybe (TPat Rational)
-> Pattern Rational
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pattern Rational
base_first TPat Rational -> Pattern Rational
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat Maybe (TPat Rational)
mSteprate)
      base_first :: Pattern Rational
base_first
        | [(Rational, Pattern a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Rational, Pattern a)]
pats = Rational -> Pattern Rational
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
0
        | Bool
otherwise = Rational -> Pattern Rational
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Pattern Rational) -> Rational -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ (Rational, Pattern a) -> Rational
forall a b. (a, b) -> a
fst ((Rational, Pattern a) -> Rational)
-> (Rational, Pattern a) -> Rational
forall a b. (a -> b) -> a -> b
$ [(Rational, Pattern a)] -> (Rational, Pattern a)
forall a. HasCallStack => [a] -> a
head [(Rational, Pattern a)]
pats
  TPat_Seq [TPat a]
xs -> (Rational, Pattern a) -> Pattern a
forall a b. (a, b) -> b
snd ((Rational, Pattern a) -> Pattern a)
-> (Rational, Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ [TPat a] -> (Rational, Pattern a)
forall a.
(Enumerable a, Parseable a) =>
[TPat a] -> (Rational, Pattern a)
resolve_seq [TPat a]
xs
  TPat_Var String
s -> String -> Pattern a
forall a. Parseable a => String -> Pattern a
getControl String
s
  TPat_Chord b -> a
f TPat b
iP TPat String
nP [TPat [Modifier]]
mP -> (b -> a)
-> Pattern b -> Pattern String -> [Pattern [Modifier]] -> Pattern a
forall a b.
(Num a, Enum a) =>
(a -> b)
-> Pattern a -> Pattern String -> [Pattern [Modifier]] -> Pattern b
chordToPatSeq b -> a
f (TPat b -> Pattern b
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat b
iP) (TPat String -> Pattern String
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat String
nP) ((TPat [Modifier] -> Pattern [Modifier])
-> [TPat [Modifier]] -> [Pattern [Modifier]]
forall a b. (a -> b) -> [a] -> [b]
map TPat [Modifier] -> Pattern [Modifier]
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat [TPat [Modifier]]
mP)
  TPat a
_ -> Pattern a
forall a. Pattern a
silence

resolve_tpat :: (Enumerable a, Parseable a) => TPat a -> (Rational, Pattern a)
resolve_tpat :: forall a.
(Enumerable a, Parseable a) =>
TPat a -> (Rational, Pattern a)
resolve_tpat (TPat_Seq [TPat a]
xs) = [TPat a] -> (Rational, Pattern a)
forall a.
(Enumerable a, Parseable a) =>
[TPat a] -> (Rational, Pattern a)
resolve_seq [TPat a]
xs
resolve_tpat TPat a
a = (Rational
1, TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
a)

resolve_seq :: (Enumerable a, Parseable a) => [TPat a] -> (Rational, Pattern a)
resolve_seq :: forall a.
(Enumerable a, Parseable a) =>
[TPat a] -> (Rational, Pattern a)
resolve_seq [TPat a]
xs = (Rational
total_size, [(Rational, Pattern a)] -> Pattern a
forall a. [(Rational, Pattern a)] -> Pattern a
timeCat [(Rational, Pattern a)]
sized_pats)
  where
    sized_pats :: [(Rational, Pattern a)]
sized_pats = ((Rational, TPat a) -> (Rational, Pattern a))
-> [(Rational, TPat a)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map (TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat (TPat a -> Pattern a)
-> (Rational, TPat a) -> (Rational, Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Rational, TPat a)] -> [(Rational, Pattern a)])
-> [(Rational, TPat a)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> a -> b
$ [TPat a] -> [(Rational, TPat a)]
forall a. [TPat a] -> [(Rational, TPat a)]
resolve_size [TPat a]
xs
    total_size :: Rational
total_size = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$ ((Rational, Pattern a) -> Rational)
-> [(Rational, Pattern a)] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Rational, Pattern a) -> Rational
forall a b. (a, b) -> a
fst [(Rational, Pattern a)]
sized_pats

resolve_size :: [TPat a] -> [(Rational, TPat a)]
resolve_size :: forall a. [TPat a] -> [(Rational, TPat a)]
resolve_size [] = []
resolve_size ((TPat_Elongate Rational
r TPat a
p) : [TPat a]
ps) = (Rational
r, TPat a
p) (Rational, TPat a) -> [(Rational, TPat a)] -> [(Rational, TPat a)]
forall a. a -> [a] -> [a]
: [TPat a] -> [(Rational, TPat a)]
forall a. [TPat a] -> [(Rational, TPat a)]
resolve_size [TPat a]
ps
resolve_size ((TPat_Repeat Int
n TPat a
p) : [TPat a]
ps) = Int -> (Rational, TPat a) -> [(Rational, TPat a)]
forall a. Int -> a -> [a]
replicate Int
n (Rational
1, TPat a
p) [(Rational, TPat a)]
-> [(Rational, TPat a)] -> [(Rational, TPat a)]
forall a. [a] -> [a] -> [a]
++ [TPat a] -> [(Rational, TPat a)]
forall a. [TPat a] -> [(Rational, TPat a)]
resolve_size [TPat a]
ps
resolve_size (TPat a
p : [TPat a]
ps) = (Rational
1, TPat a
p) (Rational, TPat a) -> [(Rational, TPat a)] -> [(Rational, TPat a)]
forall a. a -> [a] -> [a]
: [TPat a] -> [(Rational, TPat a)]
forall a. [TPat a] -> [(Rational, TPat a)]
resolve_size [TPat a]
ps

steps_tpat :: (Show a) => TPat a -> (Rational, String)
steps_tpat :: forall a. Show a => TPat a -> (Rational, String)
steps_tpat (TPat_Seq [TPat a]
xs) = [TPat a] -> (Rational, String)
forall a. Show a => [TPat a] -> (Rational, String)
steps_seq [TPat a]
xs
steps_tpat TPat a
a = (Rational
1, TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
a)

steps_seq :: (Show a) => [TPat a] -> (Rational, String)
steps_seq :: forall a. Show a => [TPat a] -> (Rational, String)
steps_seq [TPat a]
xs = (Rational
total_size, String
"timeCat [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (((Rational, String) -> String) -> [(Rational, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rational
r, String
s) -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") [(Rational, String)]
sized_pats) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]")
  where
    sized_pats :: [(Rational, String)]
sized_pats = [TPat a] -> [(Rational, String)]
forall a. Show a => [TPat a] -> [(Rational, String)]
steps_size [TPat a]
xs
    total_size :: Rational
total_size = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$ ((Rational, String) -> Rational)
-> [(Rational, String)] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Rational, String) -> Rational
forall a b. (a, b) -> a
fst [(Rational, String)]
sized_pats

steps_size :: (Show a) => [TPat a] -> [(Rational, String)]
steps_size :: forall a. Show a => [TPat a] -> [(Rational, String)]
steps_size [] = []
steps_size ((TPat_Elongate Rational
r TPat a
p) : [TPat a]
ps) = (Rational
r, TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
p) (Rational, String) -> [(Rational, String)] -> [(Rational, String)]
forall a. a -> [a] -> [a]
: [TPat a] -> [(Rational, String)]
forall a. Show a => [TPat a] -> [(Rational, String)]
steps_size [TPat a]
ps
steps_size ((TPat_Repeat Int
n TPat a
p) : [TPat a]
ps) = Int -> (Rational, String) -> [(Rational, String)]
forall a. Int -> a -> [a]
replicate Int
n (Rational
1, TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
p) [(Rational, String)]
-> [(Rational, String)] -> [(Rational, String)]
forall a. [a] -> [a] -> [a]
++ [TPat a] -> [(Rational, String)]
forall a. Show a => [TPat a] -> [(Rational, String)]
steps_size [TPat a]
ps
steps_size (TPat a
p : [TPat a]
ps) = (Rational
1, TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
p) (Rational, String) -> [(Rational, String)] -> [(Rational, String)]
forall a. a -> [a] -> [a]
: [TPat a] -> [(Rational, String)]
forall a. Show a => [TPat a] -> [(Rational, String)]
steps_size [TPat a]
ps

parseBP :: (Enumerable a, Parseable a) => String -> Either ParseError (Pattern a)
parseBP :: forall a.
(Enumerable a, Parseable a) =>
String -> Either ParseError (Pattern a)
parseBP String
s = TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat (TPat a -> Pattern a)
-> Either ParseError (TPat a) -> Either ParseError (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either ParseError (TPat a)
forall a. Parseable a => String -> Either ParseError (TPat a)
parseTPat String
s

parseBP_E :: (Enumerable a, Parseable a) => String -> Pattern a
parseBP_E :: forall a. (Enumerable a, Parseable a) => String -> Pattern a
parseBP_E String
s = Either ParseError (TPat a) -> Pattern a
toE Either ParseError (TPat a)
parsed
  where
    parsed :: Either ParseError (TPat a)
parsed = String -> Either ParseError (TPat a)
forall a. Parseable a => String -> Either ParseError (TPat a)
parseTPat String
s
    -- TODO - custom error
    toE :: Either ParseError (TPat a) -> Pattern a
toE (Left ParseError
e) = TidalParseError -> Pattern a
forall a e. Exception e => e -> a
E.throw (TidalParseError -> Pattern a) -> TidalParseError -> Pattern a
forall a b. (a -> b) -> a -> b
$ TidalParseError {parsecError :: ParseError
parsecError = ParseError
e, code :: String
code = String
s}
    toE (Right TPat a
tp) = TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
tp

parseTPat :: (Parseable a) => String -> Either ParseError (TPat a)
parseTPat :: forall a. Parseable a => String -> Either ParseError (TPat a)
parseTPat = GenParser Char Int (TPat a)
-> Int -> String -> String -> Either ParseError (TPat a)
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser (GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pTidal GenParser Char Int (TPat a)
forall a. Parseable a => MyParser (TPat a)
parseRest GenParser Char Int (TPat a)
-> ParsecT String Int Identity () -> GenParser Char Int (TPat a)
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String Int Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) (Int
0 :: Int) String
""

-- | a '-' is a negative sign if followed anything but another dash
-- otherwise, it's treated as rest
parseRest :: (Parseable a) => MyParser (TPat a)
parseRest :: forall a. Parseable a => MyParser (TPat a)
parseRest =
  GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall tok st a. GenParser tok st a -> GenParser tok st a
try
    ( do
        ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String Int Identity Char
 -> ParsecT String Int Identity Char)
-> ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
forall a b. (a -> b) -> a -> b
$ do
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
          ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
          String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"-"
        GenParser Char Int (TPat a)
forall a. Parseable a => MyParser (TPat a)
tPatParser
    )
    GenParser Char Int (TPat a)
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
    ParsecT String Int Identity Char
-> TPat a -> GenParser Char Int (TPat a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TPat a
forall a. TPat a
TPat_Silence
      GenParser Char Int (TPat a)
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char Int (TPat a)
forall a. Parseable a => MyParser (TPat a)
tPatParser
      GenParser Char Int (TPat a)
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'~'
    ParsecT String Int Identity Char
-> TPat a -> GenParser Char Int (TPat a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TPat a
forall a. TPat a
TPat_Silence

cP :: (Enumerable a, Parseable a) => String -> Pattern a
cP :: forall a. (Enumerable a, Parseable a) => String -> Pattern a
cP String
s = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ String -> Pattern a
forall a. (Enumerable a, Parseable a) => String -> Pattern a
parseBP_E (String -> Pattern a) -> Pattern String -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Maybe String) -> String -> Pattern String
forall a. (Value -> Maybe a) -> String -> Pattern a
_cX_ Value -> Maybe String
getS String
s

class Parseable a where
  tPatParser :: MyParser (TPat a)
  doEuclid :: Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
  getControl :: String -> Pattern a
  getControl String
_ = Pattern a
forall a. Pattern a
silence

class Enumerable a where
  fromTo :: a -> a -> Pattern a
  fromThenTo :: a -> a -> a -> Pattern a

instance Parseable Char where
  tPatParser :: MyParser (TPat Char)
tPatParser = MyParser (TPat Char)
pChar
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Char -> Pattern Char
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Char -> Pattern Char
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff

instance Enumerable Char where
  fromTo :: Char -> Char -> Pattern Char
fromTo = Char -> Char -> Pattern Char
forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Char -> Char -> Char -> Pattern Char
fromThenTo Char
a Char
b Char
c = String -> Pattern Char
forall a. [a] -> Pattern a
fastFromList [Char
a, Char
b, Char
c]

instance Parseable Double where
  tPatParser :: MyParser (TPat Double)
tPatParser = MyParser (TPat Double)
pDouble
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Double -> Pattern Double
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Double -> Pattern Double
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff
  getControl :: String -> Pattern Double
getControl = String -> Pattern Double
cF_

instance Enumerable Double where
  fromTo :: Double -> Double -> Pattern Double
fromTo = Double -> Double -> Pattern Double
forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Double -> Double -> Double -> Pattern Double
fromThenTo = Double -> Double -> Double -> Pattern Double
forall a. (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo'

instance Parseable Note where
  tPatParser :: MyParser (TPat Note)
tPatParser = MyParser (TPat Note)
pNote
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Note -> Pattern Note
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Note -> Pattern Note
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff
  getControl :: String -> Pattern Note
getControl = String -> Pattern Note
cN_

instance Enumerable Note where
  fromTo :: Note -> Note -> Pattern Note
fromTo = Note -> Note -> Pattern Note
forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Note -> Note -> Note -> Pattern Note
fromThenTo = Note -> Note -> Note -> Pattern Note
forall a. (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo'

instance Parseable String where
  tPatParser :: MyParser (TPat String)
tPatParser = MyParser (TPat String)
pVocable
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern String -> Pattern String
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern String -> Pattern String
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff
  getControl :: String -> Pattern String
getControl = String -> Pattern String
cS_

instance Enumerable String where
  fromTo :: String -> String -> Pattern String
fromTo String
a String
b = [String] -> Pattern String
forall a. [a] -> Pattern a
fastFromList [String
a, String
b]
  fromThenTo :: String -> String -> String -> Pattern String
fromThenTo String
a String
b String
c = [String] -> Pattern String
forall a. [a] -> Pattern a
fastFromList [String
a, String
b, String
c]

instance Parseable Bool where
  tPatParser :: MyParser (TPat Bool)
tPatParser = MyParser (TPat Bool)
pBool
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Bool -> Pattern Bool
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Bool -> Pattern Bool
euclidOffBool
  getControl :: String -> Pattern Bool
getControl = String -> Pattern Bool
cB_

instance Enumerable Bool where
  fromTo :: Bool -> Bool -> Pattern Bool
fromTo Bool
a Bool
b = [Bool] -> Pattern Bool
forall a. [a] -> Pattern a
fastFromList [Bool
a, Bool
b]
  fromThenTo :: Bool -> Bool -> Bool -> Pattern Bool
fromThenTo Bool
a Bool
b Bool
c = [Bool] -> Pattern Bool
forall a. [a] -> Pattern a
fastFromList [Bool
a, Bool
b, Bool
c]

instance Parseable Int where
  tPatParser :: MyParser (TPat Int)
tPatParser = MyParser (TPat Int)
forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Int -> Pattern Int
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Int -> Pattern Int
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff
  getControl :: String -> Pattern Int
getControl = String -> Pattern Int
cI_

instance Enumerable Int where
  fromTo :: Int -> Int -> Pattern Int
fromTo = Int -> Int -> Pattern Int
forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Int -> Int -> Int -> Pattern Int
fromThenTo = Int -> Int -> Int -> Pattern Int
forall a. (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo'

instance Parseable Integer where
  tPatParser :: MyParser (TPat Integer)
tPatParser = MyParser (TPat Integer)
forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Integer -> Pattern Integer
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Integer -> Pattern Integer
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff
  getControl :: String -> Pattern Integer
getControl = (Int -> Integer) -> Pattern Int -> Pattern Integer
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pattern Int -> Pattern Integer)
-> (String -> Pattern Int) -> String -> Pattern Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pattern Int
cI_

instance Enumerable Integer where
  fromTo :: Integer -> Integer -> Pattern Integer
fromTo = Integer -> Integer -> Pattern Integer
forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Integer -> Integer -> Integer -> Pattern Integer
fromThenTo = Integer -> Integer -> Integer -> Pattern Integer
forall a. (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo'

instance Parseable Rational where
  tPatParser :: MyParser (TPat Rational)
tPatParser = MyParser (TPat Rational)
pRational
  doEuclid :: Pattern Int
-> Pattern Int
-> Pattern Int
-> Pattern Rational
-> Pattern Rational
doEuclid = Pattern Int
-> Pattern Int
-> Pattern Int
-> Pattern Rational
-> Pattern Rational
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff
  getControl :: String -> Pattern Rational
getControl = String -> Pattern Rational
cR_

instance Enumerable Rational where
  fromTo :: Rational -> Rational -> Pattern Rational
fromTo = Rational -> Rational -> Pattern Rational
forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Rational -> Rational -> Rational -> Pattern Rational
fromThenTo = Rational -> Rational -> Rational -> Pattern Rational
forall a. (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo'

enumFromTo' :: (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo' :: forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo' a
a a
b
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b = [a] -> Pattern a
forall a. [a] -> Pattern a
fastFromList ([a] -> Pattern a) -> [a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> a -> [a]
forall a. Enum a => a -> a -> [a]
enumFromTo a
b a
a
  | Bool
otherwise = [a] -> Pattern a
forall a. [a] -> Pattern a
fastFromList ([a] -> Pattern a) -> [a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ a -> a -> [a]
forall a. Enum a => a -> a -> [a]
enumFromTo a
a a
b

enumFromThenTo' :: (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo' :: forall a. (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo' a
a a
b a
c
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
c = [a] -> Pattern a
forall a. [a] -> Pattern a
fastFromList ([a] -> Pattern a) -> [a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> [a]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo a
c (a
c a -> a -> a
forall a. Num a => a -> a -> a
+ (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b)) a
a
  | Bool
otherwise = [a] -> Pattern a
forall a. [a] -> Pattern a
fastFromList ([a] -> Pattern a) -> [a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> [a]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo a
a a
b a
c

type ColourD = Colour Double

instance Parseable ColourD where
  tPatParser :: MyParser (TPat ColourD)
tPatParser = MyParser (TPat ColourD)
pColour
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern ColourD -> Pattern ColourD
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern ColourD -> Pattern ColourD
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff

instance Enumerable ColourD where
  fromTo :: ColourD -> ColourD -> Pattern ColourD
fromTo ColourD
a ColourD
b = [ColourD] -> Pattern ColourD
forall a. [a] -> Pattern a
fastFromList [ColourD
a, ColourD
b]
  fromThenTo :: ColourD -> ColourD -> ColourD -> Pattern ColourD
fromThenTo ColourD
a ColourD
b ColourD
c = [ColourD] -> Pattern ColourD
forall a. [a] -> Pattern a
fastFromList [ColourD
a, ColourD
b, ColourD
c]

instance (Enumerable a, Parseable a) => IsString (Pattern a) where
  fromString :: String -> Pattern a
fromString = String -> Pattern a
forall a. (Enumerable a, Parseable a) => String -> Pattern a
parseBP_E

lexer :: P.GenTokenParser String u Data.Functor.Identity.Identity
lexer :: forall u. GenTokenParser String u Identity
lexer = GenLanguageDef String u Identity
-> GenTokenParser String u Identity
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser GenLanguageDef String u Identity
forall st. LanguageDef st
haskellDef

braces, brackets, parens, angles :: MyParser a -> MyParser a
braces :: forall a. MyParser a -> MyParser a
braces MyParser a
p = Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT String Int Identity Char -> MyParser a -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MyParser a
p MyParser a -> ParsecT String Int Identity Char -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
brackets :: forall a. MyParser a -> MyParser a
brackets MyParser a
p = Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT String Int Identity Char -> MyParser a -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MyParser a
p MyParser a -> ParsecT String Int Identity Char -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
parens :: forall a. MyParser a -> MyParser a
parens MyParser a
p = Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String Int Identity Char -> MyParser a -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MyParser a
p MyParser a -> ParsecT String Int Identity Char -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
angles :: forall a. MyParser a -> MyParser a
angles MyParser a
p = Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<' ParsecT String Int Identity Char -> MyParser a -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MyParser a
p MyParser a -> ParsecT String Int Identity Char -> MyParser a
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'

symbol :: String -> MyParser String
symbol :: String -> MyParser String
symbol = GenTokenParser String Int Identity -> String -> MyParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m String
P.symbol GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer

natural, integer, decimal :: MyParser Integer
natural :: MyParser Integer
natural = GenTokenParser String Int Identity -> MyParser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
P.natural GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer
integer :: MyParser Integer
integer = GenTokenParser String Int Identity -> MyParser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
P.integer GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer
decimal :: MyParser Integer
decimal = GenTokenParser String Int Identity -> MyParser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
P.integer GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer

float :: MyParser Double
float :: MyParser Double
float = GenTokenParser String Int Identity -> MyParser Double
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Double
P.float GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer

naturalOrFloat :: MyParser (Either Integer Double)
naturalOrFloat :: MyParser (Either Integer Double)
naturalOrFloat = GenTokenParser String Int Identity
-> MyParser (Either Integer Double)
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m (Either Integer Double)
P.naturalOrFloat GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer

data Sign = Positive | Negative

applySign :: (Num a) => Sign -> a -> a
applySign :: forall a. Num a => Sign -> a -> a
applySign Sign
Positive = a -> a
forall a. a -> a
id
applySign Sign
Negative = a -> a
forall a. Num a => a -> a
negate

sign :: MyParser Sign
sign :: MyParser Sign
sign =
  do
    Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
    Sign -> MyParser Sign
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Negative
    MyParser Sign -> MyParser Sign -> MyParser Sign
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
      Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
      Sign -> MyParser Sign
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Positive
    MyParser Sign -> MyParser Sign -> MyParser Sign
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Sign -> MyParser Sign
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Positive

intOrFloat :: MyParser Double
intOrFloat :: MyParser Double
intOrFloat = MyParser Double -> MyParser Double
forall tok st a. GenParser tok st a -> GenParser tok st a
try MyParser Double
pFloat MyParser Double -> MyParser Double -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser Double
pInteger

-- | parser starting point
pTidal :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a)
pTidal :: forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pTidal MyParser (TPat a)
f = do
  TPat a
x <- do
    TPat a
s <- MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f MyParser (TPat a) -> String -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"sequence"
    TPat a -> MyParser (TPat a)
stackTail TPat a
s MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> MyParser (TPat a)
chooseTail TPat a
s MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
s
  TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pMult TPat a
x
  where
    stackTail :: TPat a -> MyParser (TPat a)
stackTail TPat a
s = do
      String -> MyParser String
symbol String
","
      [TPat a]
ss <- MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f MyParser (TPat a)
-> MyParser String -> ParsecT String Int Identity [TPat a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` String -> MyParser String
symbol String
","
      TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ [TPat a] -> TPat a
forall a. [TPat a] -> TPat a
TPat_Stack (TPat a
s TPat a -> [TPat a] -> [TPat a]
forall a. a -> [a] -> [a]
: [TPat a]
ss)
    chooseTail :: TPat a -> MyParser (TPat a)
chooseTail TPat a
s = do
      String -> MyParser String
symbol String
"|"
      [TPat a]
ss <- MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f MyParser (TPat a)
-> MyParser String -> ParsecT String Int Identity [TPat a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` String -> MyParser String
symbol String
"|"
      Int
seed <- MyParser Int
newSeed
      TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ Int -> [TPat a] -> TPat a
forall a. Int -> [TPat a] -> TPat a
TPat_CycleChoose Int
seed (TPat a
s TPat a -> [TPat a] -> [TPat a]
forall a. a -> [a] -> [a]
: [TPat a]
ss)

-- | Try different parsers on a sequence of Tidal patterns
-- 'f' is the sequence so far, 'a' the next upcoming token/non-terminal
pSequence :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a)
pSequence :: forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f = do
  ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [TPat a]
s <-
    MyParser (TPat a) -> ParsecT String Int Identity [TPat a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (MyParser (TPat a) -> ParsecT String Int Identity [TPat a])
-> MyParser (TPat a) -> ParsecT String Int Identity [TPat a]
forall a b. (a -> b) -> a -> b
$
      do
        TPat a
a <- MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat a)
f
        ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
        MyParser (TPat a) -> TPat a -> MyParser (TPat a)
forall a.
Parseable a =>
MyParser (TPat a) -> TPat a -> MyParser (TPat a)
pEnumeration MyParser (TPat a)
f TPat a
a
          MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pElongate TPat a
a
          MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pRepeat TPat a
a
          MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
a
        MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat a)
forall a. MyParser (TPat a)
pFoot
  TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pRand (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ [TPat a] -> TPat a
forall a. [TPat a] -> TPat a
resolve_feet [TPat a]
s
  where
    resolve_feet :: [TPat a] -> TPat a
resolve_feet [TPat a]
ps
      | [[TPat a]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[TPat a]]
ss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = [TPat a] -> TPat a
forall a. [TPat a] -> TPat a
TPat_Seq ([TPat a] -> TPat a) -> [TPat a] -> TPat a
forall a b. (a -> b) -> a -> b
$ ([TPat a] -> TPat a) -> [[TPat a]] -> [TPat a]
forall a b. (a -> b) -> [a] -> [b]
map [TPat a] -> TPat a
forall a. [TPat a] -> TPat a
TPat_Seq [[TPat a]]
ss
      | Bool
otherwise = [TPat a] -> TPat a
forall a. [TPat a] -> TPat a
TPat_Seq [TPat a]
ps
      where
        ss :: [[TPat a]]
ss = [TPat a] -> [[TPat a]]
forall t. [TPat t] -> [[TPat t]]
splitFeet [TPat a]
ps
    splitFeet :: [TPat t] -> [[TPat t]]
    splitFeet :: forall t. [TPat t] -> [[TPat t]]
splitFeet [] = []
    splitFeet [TPat t]
pats = [TPat t]
foot [TPat t] -> [[TPat t]] -> [[TPat t]]
forall a. a -> [a] -> [a]
: [TPat t] -> [[TPat t]]
forall t. [TPat t] -> [[TPat t]]
splitFeet [TPat t]
pats'
      where
        ([TPat t]
foot, [TPat t]
pats') = [TPat t] -> ([TPat t], [TPat t])
forall {a}. [TPat a] -> ([TPat a], [TPat a])
takeFoot [TPat t]
pats
        takeFoot :: [TPat a] -> ([TPat a], [TPat a])
takeFoot [] = ([], [])
        takeFoot (TPat a
TPat_Foot : [TPat a]
pats'') = ([], [TPat a]
pats'')
        takeFoot (TPat a
pat : [TPat a]
pats'') = ([TPat a] -> [TPat a])
-> ([TPat a], [TPat a]) -> ([TPat a], [TPat a])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TPat a
pat TPat a -> [TPat a] -> [TPat a]
forall a. a -> [a] -> [a]
:) (([TPat a], [TPat a]) -> ([TPat a], [TPat a]))
-> ([TPat a], [TPat a]) -> ([TPat a], [TPat a])
forall a b. (a -> b) -> a -> b
$ [TPat a] -> ([TPat a], [TPat a])
takeFoot [TPat a]
pats''

pFoot :: MyParser (TPat a)
pFoot :: forall a. MyParser (TPat a)
pFoot = String -> MyParser String
symbol String
"." MyParser String
-> ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
forall a. TPat a
TPat_Foot

pEnumeration :: (Parseable a) => MyParser (TPat a) -> TPat a -> MyParser (TPat a)
pEnumeration :: forall a.
Parseable a =>
MyParser (TPat a) -> TPat a -> MyParser (TPat a)
pEnumeration MyParser (TPat a)
f TPat a
a = do
  MyParser String -> MyParser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (MyParser String -> MyParser String)
-> MyParser String -> MyParser String
forall a b. (a -> b) -> a -> b
$ String -> MyParser String
symbol String
".."
  TPat a
b <- MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat a)
f
  TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ TPat a -> TPat a -> TPat a
forall a. TPat a -> TPat a -> TPat a
TPat_EnumFromTo TPat a
a TPat a
b

pRepeat :: TPat a -> MyParser (TPat a)
pRepeat :: forall a. TPat a -> MyParser (TPat a)
pRepeat TPat a
a = do
  [Int]
es <- MyParser Int -> ParsecT String Int Identity [Int]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (MyParser Int -> ParsecT String Int Identity [Int])
-> MyParser Int -> ParsecT String Int Identity [Int]
forall a b. (a -> b) -> a -> b
$ do
    Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!'
    Int
n <- (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> Int) -> MyParser String -> MyParser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) MyParser Int -> MyParser Int -> MyParser Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> MyParser Int
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
    ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    Int -> MyParser Int
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
  TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ Int -> TPat a -> TPat a
forall a. Int -> TPat a -> TPat a
TPat_Repeat (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
es) TPat a
a

pElongate :: TPat a -> MyParser (TPat a)
pElongate :: forall a. TPat a -> MyParser (TPat a)
pElongate TPat a
a = do
  [Rational]
rs <- ParsecT String Int Identity Rational
-> ParsecT String Int Identity [Rational]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String Int Identity Rational
 -> ParsecT String Int Identity [Rational])
-> ParsecT String Int Identity Rational
-> ParsecT String Int Identity [Rational]
forall a b. (a -> b) -> a -> b
$ do
    String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"@_"
    Rational
r <- (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
subtract Rational
1 (Rational -> Rational)
-> ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Rational
pRatio) ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Rational -> ParsecT String Int Identity Rational
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
1
    ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    Rational -> ParsecT String Int Identity Rational
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
r
  TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ Rational -> TPat a -> TPat a
forall a. Rational -> TPat a -> TPat a
TPat_Elongate (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
rs) TPat a
a

pSingle :: MyParser (TPat a) -> MyParser (TPat a)
pSingle :: forall a. MyParser (TPat a) -> MyParser (TPat a)
pSingle MyParser (TPat a)
f = MyParser (TPat a)
f MyParser (TPat a)
-> (TPat a -> MyParser (TPat a)) -> MyParser (TPat a)
forall a b.
ParsecT String Int Identity a
-> (a -> ParsecT String Int Identity b)
-> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pRand MyParser (TPat a)
-> (TPat a -> MyParser (TPat a)) -> MyParser (TPat a)
forall a b.
ParsecT String Int Identity a
-> (a -> ParsecT String Int Identity b)
-> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pMult

pVar :: MyParser (TPat a)
pVar :: forall a. MyParser (TPat a)
pVar = MyParser (TPat a) -> MyParser (TPat a)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat a) -> MyParser (TPat a))
-> MyParser (TPat a) -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'
  String
name <- ParsecT String Int Identity Char -> MyParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"0123456789:.-_") MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"string"
  TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ String -> TPat a
forall a. String -> TPat a
TPat_Var String
name

pPart :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a)
pPart :: forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat a)
f = (MyParser (TPat a) -> MyParser (TPat a)
forall a. MyParser (TPat a) -> MyParser (TPat a)
pSingle MyParser (TPat a)
f MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat a)
f MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat a)
f MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat a)
forall a. MyParser (TPat a)
pVar) MyParser (TPat a)
-> (TPat a -> MyParser (TPat a)) -> MyParser (TPat a)
forall a b.
ParsecT String Int Identity a
-> (a -> ParsecT String Int Identity b)
-> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pE MyParser (TPat a)
-> (TPat a -> MyParser (TPat a)) -> MyParser (TPat a)
forall a b.
ParsecT String Int Identity a
-> (a -> ParsecT String Int Identity b)
-> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pRand

newSeed :: MyParser Int
newSeed :: MyParser Int
newSeed = do
  Int
seed <- MyParser Int
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
Text.Parsec.Prim.getState
  (Int -> Int) -> ParsecT String Int Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
Text.Parsec.Prim.modifyState (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int -> MyParser Int
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
seed

pPolyIn :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn :: forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat a)
f = do
  TPat a
x <- MyParser (TPat a) -> MyParser (TPat a)
forall a. MyParser a -> MyParser a
brackets (MyParser (TPat a) -> MyParser (TPat a))
-> MyParser (TPat a) -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pTidal MyParser (TPat a)
f
  TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pMult TPat a
x

pPolyOut :: (Parseable a) => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut :: forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat a)
f =
  do
    [TPat a]
ss <- MyParser [TPat a] -> MyParser [TPat a]
forall a. MyParser a -> MyParser a
braces (MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f MyParser (TPat a) -> MyParser String -> MyParser [TPat a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` String -> MyParser String
symbol String
",")
    Maybe (TPat Rational)
base <-
      do
        Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
        TPat Rational
r <- MyParser (TPat Rational) -> MyParser (TPat Rational)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat Rational)
pRational MyParser (TPat Rational) -> String -> MyParser (TPat Rational)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"rational number"
        Maybe (TPat Rational)
-> ParsecT String Int Identity (Maybe (TPat Rational))
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TPat Rational)
 -> ParsecT String Int Identity (Maybe (TPat Rational)))
-> Maybe (TPat Rational)
-> ParsecT String Int Identity (Maybe (TPat Rational))
forall a b. (a -> b) -> a -> b
$ TPat Rational -> Maybe (TPat Rational)
forall a. a -> Maybe a
Just TPat Rational
r
        ParsecT String Int Identity (Maybe (TPat Rational))
-> ParsecT String Int Identity (Maybe (TPat Rational))
-> ParsecT String Int Identity (Maybe (TPat Rational))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe (TPat Rational)
-> ParsecT String Int Identity (Maybe (TPat Rational))
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TPat Rational)
forall a. Maybe a
Nothing
    TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pMult (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ Maybe (TPat Rational) -> [TPat a] -> TPat a
forall a. Maybe (TPat Rational) -> [TPat a] -> TPat a
TPat_Polyrhythm Maybe (TPat Rational)
base [TPat a]
ss
    MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
      [TPat a]
ss <- MyParser [TPat a] -> MyParser [TPat a]
forall a. MyParser a -> MyParser a
angles (MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f MyParser (TPat a) -> MyParser String -> MyParser [TPat a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` String -> MyParser String
symbol String
",")
      TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pMult (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ Maybe (TPat Rational) -> [TPat a] -> TPat a
forall a. Maybe (TPat Rational) -> [TPat a] -> TPat a
TPat_Polyrhythm (TPat Rational -> Maybe (TPat Rational)
forall a. a -> Maybe a
Just (TPat Rational -> Maybe (TPat Rational))
-> TPat Rational -> Maybe (TPat Rational)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Rational -> TPat Rational
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing Rational
1) [TPat a]
ss

pCharNum :: MyParser Char
pCharNum :: ParsecT String Int Identity Char
pCharNum = (ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"0123456789") ParsecT String Int Identity Char
-> String -> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"letter or number"

pString :: MyParser String
pString :: MyParser String
pString = do
  Char
c <- ParsecT String Int Identity Char
pCharNum ParsecT String Int Identity Char
-> String -> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"charnum"
  String
cs <- ParsecT String Int Identity Char -> MyParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"0123456789:.-_") MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"string"
  String -> MyParser String
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs)

wrapPos :: MyParser (TPat a) -> MyParser (TPat a)
wrapPos :: forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos MyParser (TPat a)
p = do
  SourcePos
b <- ParsecT String Int Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  TPat a
tpat <- MyParser (TPat a)
p
  SourcePos
e <- ParsecT String Int Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let addPos :: TPat a -> TPat a
addPos (TPat_Atom Maybe ((Int, Int), (Int, Int))
_ a
v') =
        Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom (((Int, Int), (Int, Int)) -> Maybe ((Int, Int), (Int, Int))
forall a. a -> Maybe a
Just ((SourcePos -> Int
sourceColumn SourcePos
b, SourcePos -> Int
sourceLine SourcePos
b), (SourcePos -> Int
sourceColumn SourcePos
e, SourcePos -> Int
sourceLine SourcePos
e))) a
v'
      addPos TPat a
x = TPat a
x -- shouldn't happen..
  TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ TPat a -> TPat a
addPos TPat a
tpat

pVocable :: MyParser (TPat String)
pVocable :: MyParser (TPat String)
pVocable = MyParser (TPat String) -> MyParser (TPat String)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat String) -> MyParser (TPat String))
-> MyParser (TPat String) -> MyParser (TPat String)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> String -> TPat String
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing (String -> TPat String)
-> MyParser String -> MyParser (TPat String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MyParser String
pString

pChar :: MyParser (TPat Char)
pChar :: MyParser (TPat Char)
pChar = MyParser (TPat Char) -> MyParser (TPat Char)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat Char) -> MyParser (TPat Char))
-> MyParser (TPat Char) -> MyParser (TPat Char)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Char -> TPat Char
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing (Char -> TPat Char)
-> ParsecT String Int Identity Char -> MyParser (TPat Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Char
pCharNum

pDouble :: MyParser (TPat Double)
pDouble :: MyParser (TPat Double)
pDouble =
  MyParser (TPat Double) -> MyParser (TPat Double)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (MyParser (TPat Double) -> MyParser (TPat Double))
-> MyParser (TPat Double) -> MyParser (TPat Double)
forall a b. (a -> b) -> a -> b
$
    do
      TPat Double
d <- MyParser (TPat Double)
pDoubleWithoutChord
      TPat Double -> MyParser (TPat Double)
forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord TPat Double
d MyParser (TPat Double)
-> MyParser (TPat Double) -> MyParser (TPat Double)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat Double -> MyParser (TPat Double)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat Double
d
      MyParser (TPat Double)
-> MyParser (TPat Double) -> MyParser (TPat Double)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat Double -> MyParser (TPat Double)
forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord (Maybe ((Int, Int), (Int, Int)) -> Double -> TPat Double
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing Double
0)
      MyParser (TPat Double)
-> MyParser (TPat Double) -> MyParser (TPat Double)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Double)
pDoubleWithoutChord

pDoubleWithoutChord :: MyParser (TPat Double)
pDoubleWithoutChord :: MyParser (TPat Double)
pDoubleWithoutChord = MyParser (TPat Double) -> MyParser (TPat Double)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart (MyParser (TPat Double) -> MyParser (TPat Double))
-> MyParser (TPat Double) -> MyParser (TPat Double)
forall a b. (a -> b) -> a -> b
$
  MyParser (TPat Double) -> MyParser (TPat Double)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat Double) -> MyParser (TPat Double))
-> MyParser (TPat Double) -> MyParser (TPat Double)
forall a b. (a -> b) -> a -> b
$ do
    Sign
s <- MyParser Sign
sign
    Double
f <- [MyParser Double] -> MyParser Double
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double)
-> ParsecT String Int Identity Rational -> MyParser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Rational
pRatio, MyParser Double
forall a. Num a => MyParser a
parseNote] MyParser Double -> String -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float"
    TPat Double -> MyParser (TPat Double)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat Double -> MyParser (TPat Double))
-> TPat Double -> MyParser (TPat Double)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Double -> TPat Double
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing (Sign -> Double -> Double
forall a. Num a => Sign -> a -> a
applySign Sign
s Double
f)

pNote :: MyParser (TPat Note)
pNote :: MyParser (TPat Note)
pNote =
  MyParser (TPat Note) -> MyParser (TPat Note)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (MyParser (TPat Note) -> MyParser (TPat Note))
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall a b. (a -> b) -> a -> b
$
    do
      TPat Note
n <- MyParser (TPat Note)
pNoteWithoutChord
      TPat Note -> MyParser (TPat Note)
forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord TPat Note
n MyParser (TPat Note)
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat Note -> MyParser (TPat Note)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat Note
n
      MyParser (TPat Note)
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat Note -> MyParser (TPat Note)
forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord (Maybe ((Int, Int), (Int, Int)) -> Note -> TPat Note
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing Note
0)
      MyParser (TPat Note)
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Note)
pNoteWithoutChord
      MyParser (TPat Note)
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Maybe ((Int, Int), (Int, Int)) -> Note -> TPat Note
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing (Note -> TPat Note) -> (Rational -> Note) -> Rational -> TPat Note
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Note
forall a. Fractional a => Rational -> a
fromRational (Rational -> TPat Note)
-> ParsecT String Int Identity Rational -> MyParser (TPat Note)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Rational
pRatio

pNoteWithoutChord :: MyParser (TPat Note)
pNoteWithoutChord :: MyParser (TPat Note)
pNoteWithoutChord = MyParser (TPat Note) -> MyParser (TPat Note)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart (MyParser (TPat Note) -> MyParser (TPat Note))
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall a b. (a -> b) -> a -> b
$
  MyParser (TPat Note) -> MyParser (TPat Note)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat Note) -> MyParser (TPat Note))
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall a b. (a -> b) -> a -> b
$ do
    Sign
s <- MyParser Sign
sign
    Double
f <- [MyParser Double] -> MyParser Double
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [MyParser Double
intOrFloat, MyParser Double
forall a. Num a => MyParser a
parseNote] MyParser Double -> String -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float"
    TPat Note -> MyParser (TPat Note)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat Note -> MyParser (TPat Note))
-> TPat Note -> MyParser (TPat Note)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Note -> TPat Note
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing (Double -> Note
Note (Double -> Note) -> Double -> Note
forall a b. (a -> b) -> a -> b
$ Sign -> Double -> Double
forall a. Num a => Sign -> a -> a
applySign Sign
s Double
f)

pBool :: MyParser (TPat Bool)
pBool :: MyParser (TPat Bool)
pBool =
  MyParser (TPat Bool) -> MyParser (TPat Bool)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat Bool) -> MyParser (TPat Bool))
-> MyParser (TPat Bool) -> MyParser (TPat Bool)
forall a b. (a -> b) -> a -> b
$
    do
      String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"t1"
      TPat Bool -> MyParser (TPat Bool)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat Bool -> MyParser (TPat Bool))
-> TPat Bool -> MyParser (TPat Bool)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Bool -> TPat Bool
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing Bool
True
      MyParser (TPat Bool)
-> MyParser (TPat Bool) -> MyParser (TPat Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
        String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"f0"
        TPat Bool -> MyParser (TPat Bool)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat Bool -> MyParser (TPat Bool))
-> TPat Bool -> MyParser (TPat Bool)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Bool -> TPat Bool
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing Bool
False

parseIntNote :: (Integral i) => MyParser i
parseIntNote :: forall i. Integral i => MyParser i
parseIntNote = do
  Sign
s <- MyParser Sign
sign
  Double
d <- [MyParser Double] -> MyParser Double
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [MyParser Double
intOrFloat, MyParser Double
forall a. Num a => MyParser a
parseNote]
  if Double -> Bool
forall a. RealFrac a => a -> Bool
isInt Double
d
    then i -> MyParser i
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> MyParser i) -> i -> MyParser i
forall a b. (a -> b) -> a -> b
$ Sign -> i -> i
forall a. Num a => Sign -> a -> a
applySign Sign
s (i -> i) -> i -> i
forall a b. (a -> b) -> a -> b
$ Double -> i
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d
    else String -> MyParser i
forall a. String -> ParsecT String Int Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not an integer"

pIntegral :: (Integral a, Parseable a, Enumerable a) => MyParser (TPat a)
pIntegral :: forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral =
  GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char Int (TPat a) -> GenParser Char Int (TPat a))
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall a b. (a -> b) -> a -> b
$
    do
      TPat a
i <- GenParser Char Int (TPat a)
forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegralWithoutChord
      TPat a -> GenParser Char Int (TPat a)
forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord TPat a
i GenParser Char Int (TPat a)
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> GenParser Char Int (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
i
      GenParser Char Int (TPat a)
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> GenParser Char Int (TPat a)
forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord (Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing a
0)
      GenParser Char Int (TPat a)
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char Int (TPat a)
forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegralWithoutChord

pIntegralWithoutChord :: (Integral a, Parseable a, Enumerable a) => MyParser (TPat a)
pIntegralWithoutChord :: forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegralWithoutChord = MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart (MyParser (TPat a) -> MyParser (TPat a))
-> MyParser (TPat a) -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ MyParser (TPat a) -> MyParser (TPat a)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat a) -> MyParser (TPat a))
-> MyParser (TPat a) -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ (a -> TPat a) -> ParsecT String Int Identity a -> MyParser (TPat a)
forall a b.
(a -> b)
-> ParsecT String Int Identity a -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing) ParsecT String Int Identity a
forall i. Integral i => MyParser i
parseIntNote

parseChord :: (Enum a, Num a) => MyParser [a]
parseChord :: forall a. (Enum a, Num a) => MyParser [a]
parseChord = do
  Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  String
name <- ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String Int Identity Char -> MyParser String)
-> ParsecT String Int Identity Char -> MyParser String
forall a b. (a -> b) -> a -> b
$ ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  let foundChord :: [a]
foundChord = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a
0] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ String -> [(String, [a])] -> Maybe [a]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, [a])]
forall a. Num a => [(String, [a])]
chordTable
  do
    Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
    ParsecT String Int Identity Char -> ParsecT String Int Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT String Int Identity ()
-> String -> ParsecT String Int Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"chord range or 'i' or 'o'"
    let n :: Int
n = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
foundChord
    Int
i <- Int -> MyParser Int -> MyParser Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
n (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> MyParser Integer -> MyParser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MyParser Integer
integer)
    Int
j <- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> MyParser String -> MyParser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Char -> MyParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i')
    Int
o <- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> MyParser String -> MyParser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Char -> MyParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'o')
    let chord' :: [a]
chord' = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
j ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
+ a
x) [a]
foundChord) [a
0, a
12 ..]
    -- open voiced chords
    let chordo' :: [a]
chordo' =
          if Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
            then [([a]
chord' [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
0 a -> a -> a
forall a. Num a => a -> a -> a
- a
12), ([a]
chord' [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
2 a -> a -> a
forall a. Num a => a -> a -> a
- a
12), ([a]
chord' [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
chord' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
chord'))
            else [a]
chord'
    [a] -> MyParser [a]
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
chordo'
    MyParser [a] -> MyParser [a] -> MyParser [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> MyParser [a]
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
foundChord

parseNote :: (Num a) => MyParser a
parseNote :: forall a. Num a => MyParser a
parseNote = do
  Integer
n <- MyParser Integer
notenum
  [Integer]
modifiers <- MyParser Integer -> ParsecT String Int Identity [Integer]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many MyParser Integer
noteModifier
  Integer
octave <- Integer -> MyParser Integer -> MyParser Integer
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Integer
5 MyParser Integer
natural
  let n' :: Integer
n' = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Integer
n [Integer]
modifiers
  a -> MyParser a
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ((Integer
octave Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
5) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12)
  where
    notenum :: MyParser Integer
    notenum :: MyParser Integer
notenum =
      [MyParser Integer] -> MyParser Integer
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
        [ Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0,
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'd' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
2,
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
4,
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
5,
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'g' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
7,
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'a' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
9,
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'b' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
11
        ]
    noteModifier :: MyParser Integer
    noteModifier :: MyParser Integer
noteModifier =
      [MyParser Integer] -> MyParser Integer
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
        [ Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
's' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1,
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1),
          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'n' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
        ]

fromNote :: (Num a) => Pattern String -> Pattern a
fromNote :: forall a. Num a => Pattern String -> Pattern a
fromNote Pattern String
pat = a -> Either ParseError a -> a
forall b a. b -> Either a b -> b
fromRight a
0 (Either ParseError a -> a)
-> (String -> Either ParseError a) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenParser Char Int a
-> Int -> String -> String -> Either ParseError a
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GenParser Char Int a
forall a. Num a => MyParser a
parseNote Int
0 String
"" (String -> a) -> Pattern String -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern String
pat

pColour :: MyParser (TPat ColourD)
pColour :: MyParser (TPat ColourD)
pColour = MyParser (TPat ColourD) -> MyParser (TPat ColourD)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat ColourD) -> MyParser (TPat ColourD))
-> MyParser (TPat ColourD) -> MyParser (TPat ColourD)
forall a b. (a -> b) -> a -> b
$ do
  String
name <- ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"colour name"
  ColourD
colour <- String -> ParsecT String Int Identity ColourD
forall (m :: * -> *) a.
(MonadFail m, Monad m, Ord a, Floating a) =>
String -> m (Colour a)
readColourName String
name ParsecT String Int Identity ColourD
-> String -> ParsecT String Int Identity ColourD
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"known colour"
  TPat ColourD -> MyParser (TPat ColourD)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat ColourD -> MyParser (TPat ColourD))
-> TPat ColourD -> MyParser (TPat ColourD)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> ColourD -> TPat ColourD
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing ColourD
colour

pMult :: TPat a -> MyParser (TPat a)
pMult :: forall a. TPat a -> MyParser (TPat a)
pMult TPat a
thing =
  do
    Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
    ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    TPat Rational
r <- MyParser (TPat Rational)
pRational MyParser (TPat Rational)
-> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat Rational)
pRational MyParser (TPat Rational)
-> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat Rational)
pRational
    TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> ParsecT String Int Identity (TPat a))
-> TPat a -> ParsecT String Int Identity (TPat a)
forall a b. (a -> b) -> a -> b
$ TPat Rational -> TPat a -> TPat a
forall a. TPat Rational -> TPat a -> TPat a
TPat_Fast TPat Rational
r TPat a
thing
    ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
      Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
      ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      TPat Rational
r <- MyParser (TPat Rational)
pRational MyParser (TPat Rational)
-> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat Rational)
pRational MyParser (TPat Rational)
-> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat Rational)
pRational
      TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> ParsecT String Int Identity (TPat a))
-> TPat a -> ParsecT String Int Identity (TPat a)
forall a b. (a -> b) -> a -> b
$ TPat Rational -> TPat a -> TPat a
forall a. TPat Rational -> TPat a -> TPat a
TPat_Slow TPat Rational
r TPat a
thing
    ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
thing

pRand :: TPat a -> MyParser (TPat a)
pRand :: forall a. TPat a -> MyParser (TPat a)
pRand TPat a
thing =
  do
    Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?'
    Double
r <- MyParser Double
float MyParser Double -> MyParser Double -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Double -> MyParser Double
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
0.5
    ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    Int
seed <- MyParser Int
newSeed
    TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> ParsecT String Int Identity (TPat a))
-> TPat a -> ParsecT String Int Identity (TPat a)
forall a b. (a -> b) -> a -> b
$ Int -> Double -> TPat a -> TPat a
forall a. Int -> Double -> TPat a -> TPat a
TPat_DegradeBy Int
seed Double
r TPat a
thing
    ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
thing

-- | parse Euclidean notation like 'bd(3,8)'
pE :: TPat a -> MyParser (TPat a)
pE :: forall a. TPat a -> MyParser (TPat a)
pE TPat a
thing =
  do
    (TPat Int
n, TPat Int
k, TPat Int
s) <- MyParser (TPat Int, TPat Int, TPat Int)
-> MyParser (TPat Int, TPat Int, TPat Int)
forall a. MyParser a -> MyParser a
parens MyParser (TPat Int, TPat Int, TPat Int)
pair
    TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TPat a -> ParsecT String Int Identity (TPat a))
-> TPat a -> ParsecT String Int Identity (TPat a)
forall a b. (a -> b) -> a -> b
$ TPat Int -> TPat Int -> TPat Int -> TPat a -> TPat a
forall a. TPat Int -> TPat Int -> TPat Int -> TPat a -> TPat a
TPat_Euclid TPat Int
n TPat Int
k TPat Int
s TPat a
thing
    ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
-> ParsecT String Int Identity (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> ParsecT String Int Identity (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
thing
  where
    pair :: MyParser (TPat Int, TPat Int, TPat Int)
    pair :: MyParser (TPat Int, TPat Int, TPat Int)
pair = do
      TPat Int
a <- MyParser (TPat Int) -> MyParser (TPat Int)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat Int)
forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
      ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      String -> MyParser String
symbol String
","
      ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      TPat Int
b <- MyParser (TPat Int) -> MyParser (TPat Int)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat Int)
forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
      TPat Int
c <-
        do
          String -> MyParser String
symbol String
","
          ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
          MyParser (TPat Int) -> MyParser (TPat Int)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat Int)
forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
          MyParser (TPat Int) -> MyParser (TPat Int) -> MyParser (TPat Int)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat Int -> MyParser (TPat Int)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ((Int, Int), (Int, Int)) -> Int -> TPat Int
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing Int
0)
      (TPat Int, TPat Int, TPat Int)
-> MyParser (TPat Int, TPat Int, TPat Int)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat Int
a, TPat Int
b, TPat Int
c)

pRational :: MyParser (TPat Rational)
pRational :: MyParser (TPat Rational)
pRational = MyParser (TPat Rational) -> MyParser (TPat Rational)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat Rational) -> MyParser (TPat Rational))
-> MyParser (TPat Rational) -> MyParser (TPat Rational)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Rational -> TPat Rational
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing (Rational -> TPat Rational)
-> ParsecT String Int Identity Rational -> MyParser (TPat Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Rational
pRatio

pRatio :: MyParser Rational
pRatio :: ParsecT String Int Identity Rational
pRatio = do
  Sign
s <- MyParser Sign
sign
  Rational
r <-
    do
      Double
n <- MyParser Double -> MyParser Double
forall tok st a. GenParser tok st a -> GenParser tok st a
try MyParser Double
intOrFloat
      Rational
v <- Double -> ParsecT String Int Identity Rational
forall a. RealFrac a => a -> ParsecT String Int Identity Rational
pFraction Double
n ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Rational -> ParsecT String Int Identity Rational
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
n)
      Rational
r <- ParsecT String Int Identity Rational
forall a. Fractional a => MyParser a
pRatioChar ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Rational -> ParsecT String Int Identity Rational
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
1
      Rational -> ParsecT String Int Identity Rational
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r)
      ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
-> ParsecT String Int Identity Rational
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Int Identity Rational
forall a. Fractional a => MyParser a
pRatioChar
  Rational -> ParsecT String Int Identity Rational
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> ParsecT String Int Identity Rational)
-> Rational -> ParsecT String Int Identity Rational
forall a b. (a -> b) -> a -> b
$ Sign -> Rational -> Rational
forall a. Num a => Sign -> a -> a
applySign Sign
s Rational
r

pInteger :: MyParser Double
pInteger :: MyParser Double
pInteger = String -> Double
forall a. Read a => String -> a
read (String -> Double) -> MyParser String -> MyParser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

pFloat :: MyParser Double
pFloat :: MyParser Double
pFloat = do
  String
i <- ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  String
d <- String -> MyParser String -> MyParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"0" (Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT String Int Identity Char
-> MyParser String -> MyParser String
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
  String
e <-
    String -> MyParser String -> MyParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option
      String
"0"
      ( Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT String Int Identity Char
-> MyParser String -> MyParser String
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
          String
s <- String -> MyParser String -> MyParser String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String Int Identity Char
-> MyParser String -> MyParser String
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> MyParser String
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-")
          String
e' <- ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
          String -> MyParser String
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> MyParser String) -> String -> MyParser String
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e'
      )
  Double -> MyParser Double
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> MyParser Double) -> Double -> MyParser Double
forall a b. (a -> b) -> a -> b
$ String -> Double
forall a. Read a => String -> a
read (String
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"e" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)

pFraction :: (RealFrac a) => a -> MyParser Rational
pFraction :: forall a. RealFrac a => a -> ParsecT String Int Identity Rational
pFraction a
n = do
  Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
  Double
d <- MyParser Double
pInteger
  if (a -> Bool
forall a. RealFrac a => a -> Bool
isInt a
n)
    then Rational -> ParsecT String Int Identity Rational
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
n) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d))
    else String -> ParsecT String Int Identity Rational
forall a. String -> ParsecT String Int Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"fractions need int numerator and denominator"

pRatioChar :: (Fractional a) => MyParser a
pRatioChar :: forall a. Fractional a => MyParser a
pRatioChar =
  Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'w' a
1
    MyParser a -> MyParser a -> MyParser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'h' a
0.5
    MyParser a -> MyParser a -> MyParser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'q' a
0.25
    MyParser a -> MyParser a -> MyParser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'e' a
0.125
    MyParser a -> MyParser a -> MyParser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
's' a
0.0625
    MyParser a -> MyParser a -> MyParser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
't' (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3)
    MyParser a -> MyParser a -> MyParser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'f' a
0.2
    MyParser a -> MyParser a -> MyParser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> a -> MyParser a
forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'x' (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
6)

pRatioSingleChar :: (Fractional a) => Char -> a -> MyParser a
pRatioSingleChar :: forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
c a
v = GenParser Char Int a -> GenParser Char Int a
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char Int a -> GenParser Char Int a)
-> GenParser Char Int a -> GenParser Char Int a
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
  ParsecT String Int Identity Char -> ParsecT String Int Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter)
  a -> GenParser Char Int a
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v

isInt :: (RealFrac a) => a -> Bool
isInt :: forall a. RealFrac a => a -> Bool
isInt a
x = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> a
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
x)

---

instance Parseable [Modifier] where
  tPatParser :: MyParser (TPat [Modifier])
tPatParser = MyParser (TPat [Modifier])
pModifiers
  doEuclid :: Pattern Int
-> Pattern Int
-> Pattern Int
-> Pattern [Modifier]
-> Pattern [Modifier]
doEuclid = Pattern Int
-> Pattern Int
-> Pattern Int
-> Pattern [Modifier]
-> Pattern [Modifier]
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff

instance Enumerable [Modifier] where
  fromTo :: [Modifier] -> [Modifier] -> Pattern [Modifier]
fromTo [Modifier]
a [Modifier]
b = [[Modifier]] -> Pattern [Modifier]
forall a. [a] -> Pattern a
fastFromList [[Modifier]
a, [Modifier]
b]
  fromThenTo :: [Modifier] -> [Modifier] -> [Modifier] -> Pattern [Modifier]
fromThenTo [Modifier]
a [Modifier]
b [Modifier]
c = [[Modifier]] -> Pattern [Modifier]
forall a. [a] -> Pattern a
fastFromList [[Modifier]
a, [Modifier]
b, [Modifier]
c]

parseModInv :: MyParser Modifier
parseModInv :: MyParser Modifier
parseModInv = Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i' ParsecT String Int Identity Char
-> MyParser Modifier -> MyParser Modifier
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> MyParser Modifier
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Invert

parseModInvNum :: MyParser [Modifier]
parseModInvNum :: MyParser [Modifier]
parseModInvNum = do
  Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i'
  Double
n <- MyParser Double
pInteger
  [Modifier] -> MyParser [Modifier]
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Modifier] -> MyParser [Modifier])
-> [Modifier] -> MyParser [Modifier]
forall a b. (a -> b) -> a -> b
$ Int -> Modifier -> [Modifier]
forall a. Int -> a -> [a]
replicate (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
n) Modifier
Invert

parseModDrop :: MyParser [Modifier]
parseModDrop :: MyParser [Modifier]
parseModDrop = do
  Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'd'
  Double
n <- MyParser Double
pInteger
  [Modifier] -> MyParser [Modifier]
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Modifier] -> MyParser [Modifier])
-> [Modifier] -> MyParser [Modifier]
forall a b. (a -> b) -> a -> b
$ [Int -> Modifier
Drop (Int -> Modifier) -> Int -> Modifier
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
n]

parseModOpen :: MyParser Modifier
parseModOpen :: MyParser Modifier
parseModOpen = Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'o' ParsecT String Int Identity Char
-> MyParser Modifier -> MyParser Modifier
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Modifier -> MyParser Modifier
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Open

parseModRange :: MyParser Modifier
parseModRange :: MyParser Modifier
parseModRange = MyParser Integer
forall i. Integral i => MyParser i
parseIntNote MyParser Integer
-> (Integer -> MyParser Modifier) -> MyParser Modifier
forall a b.
ParsecT String Int Identity a
-> (a -> ParsecT String Int Identity b)
-> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
i -> Modifier -> MyParser Modifier
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Modifier -> MyParser Modifier) -> Modifier -> MyParser Modifier
forall a b. (a -> b) -> a -> b
$ Int -> Modifier
Range (Int -> Modifier) -> Int -> Modifier
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i :: Integer)

parseModifiers :: MyParser [Modifier]
parseModifiers :: MyParser [Modifier]
parseModifiers = (MyParser Modifier -> MyParser [Modifier]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 MyParser Modifier
parseModOpen) MyParser [Modifier] -> MyParser [Modifier] -> MyParser [Modifier]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser [Modifier]
parseModDrop MyParser [Modifier] -> MyParser [Modifier] -> MyParser [Modifier]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Modifier -> [Modifier])
-> MyParser Modifier -> MyParser [Modifier]
forall a b.
(a -> b)
-> ParsecT String Int Identity a -> ParsecT String Int Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Modifier -> [Modifier]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure MyParser Modifier
parseModRange) MyParser [Modifier] -> MyParser [Modifier] -> MyParser [Modifier]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser [Modifier] -> MyParser [Modifier]
forall tok st a. GenParser tok st a -> GenParser tok st a
try MyParser [Modifier]
parseModInvNum MyParser [Modifier] -> MyParser [Modifier] -> MyParser [Modifier]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (MyParser Modifier -> MyParser [Modifier]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 MyParser Modifier
parseModInv) MyParser [Modifier] -> String -> MyParser [Modifier]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"modifier"

pModifiers :: MyParser (TPat [Modifier])
pModifiers :: MyParser (TPat [Modifier])
pModifiers = MyParser (TPat [Modifier]) -> MyParser (TPat [Modifier])
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat [Modifier]) -> MyParser (TPat [Modifier]))
-> MyParser (TPat [Modifier]) -> MyParser (TPat [Modifier])
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> [Modifier] -> TPat [Modifier]
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing ([Modifier] -> TPat [Modifier])
-> MyParser [Modifier] -> MyParser (TPat [Modifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MyParser [Modifier]
parseModifiers

pChord :: (Enum a, Num a, Parseable a, Enumerable a) => TPat a -> MyParser (TPat a)
pChord :: forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord TPat a
i = do
  Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  TPat String
n <- MyParser (TPat String) -> MyParser (TPat String)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat String)
pVocable MyParser (TPat String) -> String -> MyParser (TPat String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"chordname"
  [TPat [Modifier]]
ms <- [TPat [Modifier]]
-> ParsecT String Int Identity [TPat [Modifier]]
-> ParsecT String Int Identity [TPat [Modifier]]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT String Int Identity [TPat [Modifier]]
 -> ParsecT String Int Identity [TPat [Modifier]])
-> ParsecT String Int Identity [TPat [Modifier]]
-> ParsecT String Int Identity [TPat [Modifier]]
forall a b. (a -> b) -> a -> b
$ MyParser (TPat [Modifier])
-> ParsecT String Int Identity [TPat [Modifier]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (MyParser (TPat [Modifier])
 -> ParsecT String Int Identity [TPat [Modifier]])
-> MyParser (TPat [Modifier])
-> ParsecT String Int Identity [TPat [Modifier]]
forall a b. (a -> b) -> a -> b
$ (Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT String Int Identity Char
-> MyParser (TPat [Modifier]) -> MyParser (TPat [Modifier])
forall a b.
ParsecT String Int Identity a
-> ParsecT String Int Identity b -> ParsecT String Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MyParser (TPat [Modifier]) -> MyParser (TPat [Modifier])
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat [Modifier])
pModifiers)
  TPat a -> MyParser (TPat a)
forall a. a -> ParsecT String Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ (a -> a) -> TPat a -> TPat String -> [TPat [Modifier]] -> TPat a
forall b a.
(Num b, Enum b, Parseable b, Enumerable b) =>
(b -> a) -> TPat b -> TPat String -> [TPat [Modifier]] -> TPat a
TPat_Chord a -> a
forall a. a -> a
id TPat a
i TPat String
n [TPat [Modifier]]
ms