{-# LANGUAGE OverloadedStrings, FlexibleInstances, CPP, DeriveFunctor, GADTs, StandaloneDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# 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.Identity (Identity)
import           Data.List (intercalate)
import           Data.Maybe
import           Data.Ratio
import           Data.Typeable (Typeable)
import           GHC.Exts ( IsString(..) )
import           Text.Parsec.Error
import           Text.ParserCombinators.Parsec
import           Text.ParserCombinators.Parsec.Language ( haskellDef )
import qualified Text.ParserCombinators.Parsec.Token as P
import qualified Text.Parsec.Prim
import           Sound.Tidal.Pattern
import           Sound.Tidal.UI
import           Sound.Tidal.Core
import           Sound.Tidal.Chords
import           Sound.Tidal.Utils (fromRight)

data TidalParseError = TidalParseError {TidalParseError -> ParseError
parsecError :: ParseError,
                                        TidalParseError -> String
code :: String
                                       }
  deriving (TidalParseError -> TidalParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TidalParseError -> TidalParseError -> Bool
$c/= :: TidalParseError -> TidalParseError -> Bool
== :: TidalParseError -> TidalParseError -> Bool
$c== :: 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  \"" forall a. [a] -> [a] -> [a]
++ TidalParseError -> String
code TidalParseError
err forall a. [a] -> [a] -> [a]
++ String
"\"\n  " forall a. [a] -> [a] -> [a]
++ String
pointer forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
message
    where pointer :: String
pointer = forall a. Int -> a -> [a]
replicate (SourcePos -> Int
sourceColumn forall a b. (a -> b) -> a -> b
$ ParseError -> SourcePos
errorPos ParseError
perr) Char
' ' 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" 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 (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe ((Int, Int), (Int, Int))
c forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Fast TPat Rational
t TPat a
v) = String
"TPat_Fast (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat Rational
t forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
v forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Slow TPat Rational
t TPat a
v) = String
"TPat_Slow (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat Rational
t forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
v forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_DegradeBy Int
x Double
r TPat a
v) = String
"TPat_DegradeBy (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Double
r forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
v forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_CycleChoose Int
x [TPat a]
vs) = String
"TPat_CycleChoose (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [TPat a]
vs forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Euclid TPat Int
a TPat Int
b TPat Int
c TPat a
v) = String
"TPat_Euclid (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat Int
a forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat Int
b forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat Int
c forall a. [a] -> [a] -> [a]
++ String
") " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
v forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Stack [TPat a]
vs) = String
"TPat_Stack " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [TPat a]
vs
  show (TPat_Polyrhythm Maybe (TPat Rational)
mSteprate [TPat a]
vs) = String
"TPat_Polyrhythm (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe (TPat Rational)
mSteprate forall a. [a] -> [a] -> [a]
++ String
") " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [TPat a]
vs
  show (TPat_Seq [TPat a]
vs) = String
"TPat_Seq " forall a. [a] -> [a] -> [a]
++ 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 (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rational
r forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
v forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Repeat Int
r TPat a
v) = String
"TPat_Repeat (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
r forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
v forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_EnumFromTo TPat a
a TPat a
b) = String
"TPat_EnumFromTo (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
a forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat a
b forall a. [a] -> [a] -> [a]
++ String
")"
  show (TPat_Var String
s) = String
"TPat_Var " forall a. [a] -> [a] -> [a]
++ 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 (" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
g TPat b
iP) forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat String
nP forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [TPat [Modifier]]
msP 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) = 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) = forall a. TPat Rational -> TPat a -> TPat a
TPat_Fast TPat Rational
t (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) = forall a. TPat Rational -> TPat a -> TPat a
TPat_Slow TPat Rational
t (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) = forall a. Int -> Double -> TPat a -> TPat a
TPat_DegradeBy Int
x Double
r (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) = forall a. Int -> [TPat a] -> TPat a
TPat_CycleChoose Int
x (forall a b. (a -> b) -> [a] -> [b]
map (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) = forall a. TPat Int -> TPat Int -> TPat Int -> TPat a -> TPat a
TPat_Euclid TPat Int
a TPat Int
b TPat Int
c (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) = forall a. [TPat a] -> TPat a
TPat_Stack (forall a b. (a -> b) -> [a] -> [b]
map (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) = forall a. Maybe (TPat Rational) -> [TPat a] -> TPat a
TPat_Polyrhythm Maybe (TPat Rational)
mSteprate (forall a b. (a -> b) -> [a] -> [b]
map (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) = forall a. [TPat a] -> TPat a
TPat_Seq (forall a b. (a -> b) -> [a] -> [b]
map (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 = forall a. TPat a
TPat_Silence
  fmap a -> b
_ TPat a
TPat_Foot = forall a. TPat a
TPat_Foot
  fmap a -> b
f (TPat_Elongate Rational
r TPat a
v) = forall a. Rational -> TPat a -> TPat a
TPat_Elongate Rational
r (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) = forall a. Int -> TPat a -> TPat a
TPat_Repeat Int
r (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) = forall a. TPat a -> TPat a -> TPat a
TPat_EnumFromTo (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TPat a
a) (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) = 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) = 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 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
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => TPat a -> String
tShow [TPat a]
vs) 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v
tShow (TPat_Fast TPat Rational
t TPat a
v) = String
"fast " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat Rational
t forall a. [a] -> [a] -> [a]
++ String
" $ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => TPat a -> String
tShow TPat a
v
tShow (TPat_Slow TPat Rational
t TPat a
v) = String
"slow " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TPat Rational
t forall a. [a] -> [a] -> [a]
++ String
" $ " forall a. [a] -> [a] -> [a]
++ 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Double
r forall a. [a] -> [a] -> [a]
++ String
" $ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => TPat a -> String
tShow TPat a
v
-- TODO - ditto
tShow (TPat_CycleChoose Int
_ [TPat a]
vs) = String
"cycleChoose " forall a. [a] -> [a] -> [a]
++ 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 (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
") (" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => TPat a -> String
tShow [TPat Int
a,TPat Int
b,TPat Int
c])  forall a. [a] -> [a] -> [a]
++ String
") $ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => TPat a -> String
tShow TPat a
v
tShow (TPat_Stack [TPat a]
vs) = String
"stack " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [TPat a] -> String
tShowList [TPat a]
vs

tShow (TPat_Polyrhythm Maybe (TPat Rational)
mSteprate [TPat a]
vs) = String
"stack [" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, String) -> String
adjust_speed [(Rational, String)]
pats) forall a. [a] -> [a] -> [a]
++ String
"]"
  where adjust_speed :: (a, String) -> String
adjust_speed (a
sz, String
pat) = String
"(fast (" forall a. [a] -> [a] -> [a]
++ (String
steprate forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
sz) forall a. [a] -> [a] -> [a]
++ String
") $ " forall a. [a] -> [a] -> [a]
++ String
pat forall a. [a] -> [a] -> [a]
++ String
")"
        steprate :: String
        steprate :: String
steprate = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
base_first forall a. Show a => TPat a -> String
tShow Maybe (TPat Rational)
mSteprate
        base_first :: String
base_first | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Rational, String)]
pats = String
"0"
                   | Bool
otherwise = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Rational, String)]
pats
        pats :: [(Rational, String)]
pats = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => TPat a -> (Rational, String)
steps_tpat [TPat a]
vs

tShow (TPat_Seq [TPat a]
vs) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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 <$> (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => TPat a -> String
tShow TPat a
a forall a. [a] -> [a] -> [a]
++ String
") <*> (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => TPat a -> String
tShow TPat a
b forall a. [a] -> [a] -> [a]
++ String
")"
tShow (TPat_Var String
s) = String
"getControl " forall a. [a] -> [a] -> [a]
++ String
s
tShow (TPat_Chord b -> a
f TPat b
n TPat String
name [TPat [Modifier]]
mods) = String
"chord (" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => TPat a -> String
tShow forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f TPat b
n) forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => TPat a -> String
tShow TPat String
name forall a. [a] -> [a] -> [a]
++ String
")" forall a. [a] -> [a] -> [a]
++ forall a. Show a => [TPat a] -> String
tShowList [TPat [Modifier]]
mods
tShow TPat a
a = String
"can't happen? " forall a. [a] -> [a] -> [a]
++ 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 -> forall a. Context -> Pattern a -> Pattern a
setContext ([((Int, Int), (Int, Int))] -> Context
Context [((Int, Int), (Int, Int))
loc]) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
   TPat_Atom Maybe ((Int, Int), (Int, Int))
Nothing a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
   TPat_Fast TPat Rational
t TPat a
x -> forall a. Pattern Rational -> Pattern a -> Pattern a
fast (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Rational
t) forall a b. (a -> b) -> a -> b
$ forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
x
   TPat_Slow TPat Rational
t TPat a
x -> forall a. Pattern Rational -> Pattern a -> Pattern a
slow (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Rational
t) forall a b. (a -> b) -> a -> b
$ forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
x
   TPat_DegradeBy Int
seed Double
amt TPat a
x -> forall a. Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing (forall a. Rational -> Pattern a -> Pattern a
rotL (Rational
0.0001 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seed) forall a. Fractional a => Pattern a
rand) Double
amt forall a b. (a -> b) -> a -> b
$ forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
x
   TPat_CycleChoose Int
seed [TPat a]
xs -> forall a. Pattern (Pattern a) -> Pattern a
unwrap forall a b. (a -> b) -> a -> b
$ forall a. Pattern Rational -> Pattern a -> Pattern a
segment Pattern Rational
1 forall a b. (a -> b) -> a -> b
$ forall a. Pattern Double -> [a] -> Pattern a
chooseBy (forall a. Rational -> Pattern a -> Pattern a
rotL (Rational
0.0001 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seed) forall a. Fractional a => Pattern a
rand) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 -> forall a.
Parseable a =>
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
doEuclid (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
n) (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
k) (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
s) (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
thing)
   TPat_Stack [TPat a]
xs -> forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat [TPat a]
xs
   TPat a
TPat_Silence -> forall a. Pattern a
silence
   TPat_EnumFromTo TPat a
a TPat a
b -> forall a. Pattern (Pattern a) -> Pattern a
unwrap forall a b. (a -> b) -> a -> b
$ forall a. Enumerable a => a -> a -> Pattern a
fromTo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
b
   TPat a
TPat_Foot -> forall a. HasCallStack => String -> a
error String
"Can't happen, feet are pre-processed."
   TPat_Polyrhythm Maybe (TPat Rational)
mSteprate [TPat a]
ps -> forall a. [Pattern a] -> Pattern a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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) = forall a. Pattern Rational -> Pattern a -> Pattern a
fast ((forall a. Fractional a => a -> a -> a
/Rational
sz) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
steprate) Pattern a
pat
           pats :: [(Rational, Pattern a)]
pats = forall a b. (a -> b) -> [a] -> [b]
map forall a.
(Enumerable a, Parseable a) =>
TPat a -> (Rational, Pattern a)
resolve_tpat [TPat a]
ps
           steprate :: Pattern Rational
           steprate :: Pattern Rational
steprate = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pattern Rational
base_first forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat Maybe (TPat Rational)
mSteprate)
           base_first :: Pattern Rational
base_first | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Rational, Pattern a)]
pats = forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
0
                      | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Rational, Pattern a)]
pats
   TPat_Seq [TPat a]
xs -> forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a.
(Enumerable a, Parseable a) =>
[TPat a] -> (Rational, Pattern a)
resolve_seq [TPat a]
xs
   TPat_Var String
s -> forall a. Parseable a => String -> Pattern a
getControl String
s
   TPat_Chord b -> a
f TPat b
iP TPat String
nP [TPat [Modifier]]
mP -> forall a b.
(Num a, Enum a) =>
(a -> b)
-> Pattern a -> Pattern String -> [Pattern [Modifier]] -> Pattern b
chordToPatSeq b -> a
f (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat b
iP) (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat String
nP) (forall a b. (a -> b) -> [a] -> [b]
map forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat [TPat [Modifier]]
mP)
   TPat 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) = forall a.
(Enumerable a, Parseable a) =>
[TPat a] -> (Rational, Pattern a)
resolve_seq [TPat a]
xs
resolve_tpat TPat a
a = (Rational
1, 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, forall a. [(Rational, Pattern a)] -> Pattern a
timeCat [(Rational, Pattern a)]
sized_pats)
  where sized_pats :: [(Rational, Pattern a)]
sized_pats = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall a b. (a -> b) -> a -> b
$ forall a. [TPat a] -> [(Rational, TPat a)]
resolve_size [TPat a]
xs
        total_size :: Rational
total_size = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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)forall a. a -> [a] -> [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) = forall a. Int -> a -> [a]
replicate Int
n (Rational
1,TPat a
p) forall a. [a] -> [a] -> [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)forall a. a -> [a] -> [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) = forall a. Show a => [TPat a] -> (Rational, String)
steps_seq [TPat a]
xs
steps_tpat TPat a
a = (Rational
1, 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 [" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map (\(Rational
r,String
s) -> String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rational
r forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")") [(Rational, String)]
sized_pats) forall a. [a] -> [a] -> [a]
++ String
"]")
  where sized_pats :: [(Rational, String)]
sized_pats = forall a. Show a => [TPat a] -> [(Rational, String)]
steps_size [TPat a]
xs
        total_size :: Rational
total_size = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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, forall a. Show a => TPat a -> String
tShow TPat a
p)forall a. a -> [a] -> [a]
: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) = forall a. Int -> a -> [a]
replicate Int
n (Rational
1, forall a. Show a => TPat a -> String
tShow TPat a
p) forall a. [a] -> [a] -> [a]
++ forall a. Show a => [TPat a] -> [(Rational, String)]
steps_size [TPat a]
ps
steps_size (TPat a
p:[TPat a]
ps) = (Rational
1,forall a. Show a => TPat a -> String
tShow TPat a
p)forall a. a -> [a] -> [a]
: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 = forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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) = forall a e. Exception e => e -> a
E.throw forall a b. (a -> b) -> a -> b
$ TidalParseError {parsecError :: ParseError
parsecError = ParseError
e, code :: String
code = String
s}
    toE (Right TPat a
tp) = 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 = forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser (forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence ParsecT String Int Identity (TPat a)
f' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
Prelude.<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) (Int
0 :: Int) String
""
  where f' :: ParsecT String Int Identity (TPat a)
f' = do forall a. Parseable a => MyParser (TPat a)
tPatParser
             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 String
symbol String
"~" forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"rest"
                    forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. Pattern (Pattern a) -> Pattern a
innerJoin forall a b. (a -> b) -> a -> b
$ forall a. (Enumerable a, Parseable a) => String -> Pattern a
parseBP_E forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
_ = 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 = forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff

instance Enumerable Char where
  fromTo :: Char -> Char -> Pattern Char
fromTo = forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Char -> Char -> Char -> Pattern Char
fromThenTo Char
a Char
b Char
c = 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 = 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 = forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Double -> Double -> Double -> Pattern Double
fromThenTo = 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 = 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 = forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Note -> Note -> Note -> Pattern Note
fromThenTo = 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 = 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 = forall a. [a] -> Pattern a
fastFromList [String
a,String
b]
  fromThenTo :: String -> String -> String -> Pattern String
fromThenTo String
a String
b String
c = 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 = forall a. [a] -> Pattern a
fastFromList [Bool
a,Bool
b]
  fromThenTo :: Bool -> Bool -> Bool -> Pattern Bool
fromThenTo Bool
a Bool
b Bool
c = forall a. [a] -> Pattern a
fastFromList [Bool
a,Bool
b,Bool
c]

instance Parseable Int where
  tPatParser :: MyParser (TPat Int)
tPatParser = forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Int -> Pattern Int
doEuclid = 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 = forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Int -> Int -> Int -> Pattern Int
fromThenTo = forall a. (Ord a, Enum a, Num a) => a -> a -> a -> Pattern a
enumFromThenTo'

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

instance Enumerable Integer where
  fromTo :: Integer -> Integer -> Pattern Integer
fromTo = forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Integer -> Integer -> Integer -> Pattern Integer
fromThenTo = 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 = 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 = forall a. (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo'
  fromThenTo :: Rational -> Rational -> Rational -> Pattern Rational
fromThenTo = 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 forall a. Ord a => a -> a -> Bool
> a
b = forall a. [a] -> Pattern a
fastFromList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
enumFromTo a
b a
a
                | Bool
otherwise = forall a. [a] -> Pattern a
fastFromList forall a b. (a -> b) -> a -> b
$ 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 forall a. Ord a => a -> a -> Bool
> a
c = forall a. [a] -> Pattern a
fastFromList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo a
c (a
c forall a. Num a => a -> a -> a
+ (a
aforall a. Num a => a -> a -> a
-a
b)) a
a
                      | Bool
otherwise = forall a. [a] -> Pattern a
fastFromList forall a b. (a -> b) -> a -> b
$ 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 = 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 = forall a. [a] -> Pattern a
fastFromList [ColourD
a,ColourD
b]
  fromThenTo :: ColourD -> ColourD -> ColourD -> Pattern ColourD
fromThenTo ColourD
a ColourD
b ColourD
c = 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 = 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   = forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser forall st. LanguageDef st
haskellDef

braces, brackets, parens, angles:: MyParser a -> MyParser a
braces :: forall a. MyParser a -> MyParser a
braces  = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.braces forall u. GenTokenParser String u Identity
lexer
brackets :: forall a. MyParser a -> MyParser a
brackets = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.brackets forall u. GenTokenParser String u Identity
lexer
parens :: forall a. MyParser a -> MyParser a
parens = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.parens forall u. GenTokenParser String u Identity
lexer
angles :: forall a. MyParser a -> MyParser a
angles = forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.angles forall u. GenTokenParser String u Identity
lexer

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

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

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

naturalOrFloat :: MyParser (Either Integer Double)
naturalOrFloat :: MyParser (Either Integer Double)
naturalOrFloat = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m (Either Integer Double)
P.naturalOrFloat 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 =  forall a. a -> a
id
applySign Sign
Negative =  forall a. Num a => a -> a
negate

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

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

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
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [TPat a]
s <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ do
    TPat a
a <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat a)
f
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    do
      forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ String -> ParsecT String Int Identity String
symbol String
".."
      TPat a
b <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat a)
f
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. TPat a -> TPat a -> TPat a
TPat_EnumFromTo TPat a
a TPat a
b
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. TPat a -> MyParser (TPat a)
pElongate TPat a
a
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. TPat a -> MyParser (TPat a)
pRepeat TPat a
a
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
a
    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 String
symbol String
"."
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. TPat a
TPat_Foot
  forall a. TPat a -> MyParser (TPat a)
pRand forall a b. (a -> b) -> a -> b
$ forall a. [TPat a] -> TPat a
resolve_feet [TPat a]
s
  where resolve_feet :: [TPat a] -> TPat a
resolve_feet [TPat a]
ps | forall (t :: * -> *) a. Foldable t => t a -> Int
length [[TPat a]]
ss forall a. Ord a => a -> a -> Bool
> Int
1 = forall a. [TPat a] -> TPat a
TPat_Seq forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [TPat a] -> TPat a
TPat_Seq [[TPat a]]
ss
                        | Bool
otherwise = forall a. [TPat a] -> TPat a
TPat_Seq [TPat a]
ps
          where ss :: [[TPat a]]
ss = 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 forall a. a -> [a] -> [a]
: forall t. [TPat t] -> [[TPat t]]
splitFeet [TPat t]
pats'
          where ([TPat t]
foot, [TPat t]
pats') = 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'') = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TPat a
patforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ [TPat a] -> ([TPat a], [TPat a])
takeFoot [TPat a]
pats''

pRepeat :: TPat a -> MyParser (TPat a)
pRepeat :: forall a. TPat a -> MyParser (TPat a)
pRepeat TPat a
a = do [Int]
es <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!'
                                Int
n <- (forall a. Num a => a -> a -> a
subtract Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
                                forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                                forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> TPat a -> TPat a
TPat_Repeat (Int
1 forall a. Num a => 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 <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"@_"
                                  Rational
r <- (forall a. Num a => a -> a -> a
subtract Rational
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Rational
pRatio) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Rational
1
                                  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                                  forall (m :: * -> *) a. Monad m => a -> m a
return Rational
r
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Rational -> TPat a -> TPat a
TPat_Elongate (Rational
1 forall a. Num a => 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. TPat a -> MyParser (TPat a)
pRand forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. TPat a -> MyParser (TPat a)
pMult

pVar :: MyParser (TPat a)
pVar :: forall a. MyParser (TPat a)
pVar = forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'
                    String
name <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"0123456789:.-_") forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"string"
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = (forall a. MyParser (TPat a) -> MyParser (TPat a)
pSingle MyParser (TPat a)
f forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat a)
f forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat a)
f forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. MyParser (TPat a)
pVar) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. TPat a -> MyParser (TPat a)
pE forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. TPat a -> MyParser (TPat a)
pRand

newSeed :: MyParser Int
newSeed :: ParsecT String Int Identity Int
newSeed = do Int
seed <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
Text.Parsec.Prim.getState
             forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
Text.Parsec.Prim.modifyState (forall a. Num a => a -> a -> a
+Int
1)
             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 <- forall a. MyParser a -> MyParser a
brackets forall a b. (a -> b) -> a -> b
$ do TPat a
s <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f 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 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 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
s
               forall a. TPat a -> MyParser (TPat a)
pMult TPat a
x
  where stackTail :: TPat a -> MyParser (TPat a)
stackTail TPat a
s = do String -> ParsecT String Int Identity String
symbol String
","
                         [TPat a]
ss <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f 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 -> ParsecT String Int Identity String
symbol String
","
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [TPat a] -> TPat a
TPat_Stack (TPat a
sforall a. a -> [a] -> [a]
:[TPat a]
ss)
        chooseTail :: TPat a -> MyParser (TPat a)
chooseTail TPat a
s = do String -> ParsecT String Int Identity String
symbol String
"|"
                          [TPat a]
ss <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f 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 -> ParsecT String Int Identity String
symbol String
"|"
                          Int
seed <- ParsecT String Int Identity Int
newSeed
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> [TPat a] -> TPat a
TPat_CycleChoose Int
seed (TPat a
sforall a. a -> [a] -> [a]
:[TPat a]
ss)

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

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

pString :: MyParser String
pString :: ParsecT String Int Identity String
pString = do Char
c <- ParsecT String Int Identity Char
pCharNum forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"charnum"
             String
cs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"0123456789:.-_") forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"string"
             forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cforall 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 <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
               TPat a
tpat <- MyParser (TPat a)
p
               SourcePos
e <- 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') =
                     forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom (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..
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TPat a -> TPat a
addPos TPat a
tpat

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

pChar :: MyParser (TPat Char)
pChar :: MyParser (TPat Char)
pChar = forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing 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 = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do TPat Double
d <- MyParser (TPat Double)
pDoubleWithoutChord
                   forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord TPat Double
d forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return TPat Double
d
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord (forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing Double
0)
                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 = forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart forall a b. (a -> b) -> a -> b
$ forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ do Sign
s <- MyParser Sign
sign
                                           Double
f <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall a. Fractional a => Rational -> a
fromRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Rational
pRatio, forall a. Num a => MyParser a
parseNote] forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float"
                                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing (forall a. Num a => Sign -> a -> a
applySign Sign
s Double
f)

pNote :: MyParser (TPat Note)
pNote :: MyParser (TPat Note)
pNote = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do TPat Note
n <- MyParser (TPat Note)
pNoteWithoutChord
                 forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord TPat Note
n forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return TPat Note
n
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord (forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing Note
0)
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Note)
pNoteWithoutChord
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational 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 = forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart forall a b. (a -> b) -> a -> b
$ forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ do Sign
s <- MyParser Sign
sign
                                         Double
f <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [MyParser Double
intOrFloat, forall a. Num a => MyParser a
parseNote] forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float"
                                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing (Double -> Note
Note forall a b. (a -> b) -> a -> b
$ forall a. Num a => Sign -> a -> a
applySign Sign
s Double
f)


pBool :: MyParser (TPat Bool)
pBool :: MyParser (TPat Bool)
pBool = forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"t1"
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing Bool
True
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  do forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"f0"
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom 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 <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [MyParser Double
intOrFloat, forall a. Num a => MyParser a
parseNote]
                  if forall a. RealFrac a => a -> Bool
isInt Double
d
                    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Sign -> a -> a
applySign Sign
s forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round Double
d
                    else 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 = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do TPat a
i <- forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegralWithoutChord
                     forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord TPat a
i forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
i
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a.
(Enum a, Num a, Parseable a, Enumerable a) =>
TPat a -> MyParser (TPat a)
pChord (forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing a
0)
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 = forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart forall a b. (a -> b) -> a -> b
$ forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing) 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 forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
                String
name <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                let foundChord :: [a]
foundChord = forall a. a -> Maybe a -> a
fromMaybe [a
0] forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name forall a. Num a => [(String, [a])]
chordTable
                do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
                   forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
foundChord
                   Int
i <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MyParser Integer
integer)
                   Int
j <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'i')
                   Int
o <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'o')
                   let chord' :: [a]
chord' = forall a. Int -> [a] -> [a]
take Int
i forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
j forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> forall a b. (a -> b) -> [a] -> [b]
map (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 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
> Int
2 then
                                     [ ([a]
chord' forall a. [a] -> Int -> a
!! Int
0 forall a. Num a => a -> a -> a
- a
12), ([a]
chord' forall a. [a] -> Int -> a
!! Int
2 forall a. Num a => a -> a -> a
- a
12), ([a]
chord' forall a. [a] -> Int -> a
!! Int
1) ] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
chord' forall a. Num a => a -> a -> a
- Int
3) (forall a. [a] -> [a]
reverse [a]
chord'))
                                 else [a]
chord'
                   forall (m :: * -> *) a. Monad m => a -> m a
return [a]
chordo'
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many MyParser Integer
noteModifier
               Integer
octave <- 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' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Num a => a -> a -> a
(+) Integer
n [Integer]
modifiers
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
n' forall a. Num a => a -> a -> a
+ ((Integer
octaveforall a. Num a => a -> a -> a
-Integer
5)forall a. Num a => a -> a -> a
*Integer
12)
  where
        notenum :: MyParser Integer
        notenum :: MyParser Integer
notenum = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0,
                          forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'd' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
2,
                          forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
4,
                          forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
5,
                          forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'g' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
7,
                          forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'a' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
9,
                          forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'b' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
11
                         ]
        noteModifier :: MyParser Integer
        noteModifier :: MyParser Integer
noteModifier = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
's' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1,
                               forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1),
                               forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'n' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = forall b a. b -> Either a b -> b
fromRight a
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser forall a. Num a => MyParser a
parseNote Int
0 String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern String
pat

pColour :: MyParser (TPat ColourD)
pColour :: MyParser (TPat ColourD)
pColour = forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ do String
name <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"colour name"
                       ColourD
colour <- forall (m :: * -> *) a.
(MonadFail m, Monad m, Ord a, Floating a) =>
String -> m (Colour a)
readColourName String
name forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"known colour"
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom 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 forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
                 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                 TPat Rational
r <- MyParser (TPat Rational)
pRational forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat Rational)
pRational forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat Rational)
pRational
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. TPat Rational -> TPat a -> TPat a
TPat_Fast TPat Rational
r TPat a
thing
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
                 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                 TPat Rational
r <- MyParser (TPat Rational)
pRational forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat Rational)
pRational forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat Rational)
pRational
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. TPat Rational -> TPat a -> TPat a
TPat_Slow TPat Rational
r TPat a
thing
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?'
                 Double
r <- MyParser Double
float forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Double
0.5
                 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                 Int
seed <- ParsecT String Int Identity Int
newSeed
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> Double -> TPat a -> TPat a
TPat_DegradeBy Int
seed Double
r TPat a
thing
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
thing

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) <- forall a. MyParser a -> MyParser a
parens MyParser (TPat Int, TPat Int, TPat Int)
pair
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
                   forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                   String -> ParsecT String Int Identity String
symbol String
","
                   forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                   TPat Int
b <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
                   TPat Int
c <- do String -> ParsecT String Int Identity String
symbol String
","
                           forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                           forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence forall a.
(Integral a, Parseable a, Enumerable a) =>
MyParser (TPat a)
pIntegral
                        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing Int
0)
                   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 = forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing 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 <- forall tok st a. GenParser tok st a -> GenParser tok st a
try MyParser Double
intOrFloat
          Rational
v <- forall a. RealFrac a => a -> ParsecT String Int Identity Rational
pFraction Double
n forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Real a => a -> Rational
toRational Double
n)
          Rational
r <- forall a. Fractional a => MyParser a
pRatioChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Rational
1
          forall (m :: * -> *) a. Monad m => a -> m a
return (Rational
v forall a. Num a => a -> a -> a
* Rational
r)
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
       forall a. Fractional a => MyParser a
pRatioChar
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Sign -> a -> a
applySign Sign
s Rational
r

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

pFloat :: MyParser Double
pFloat :: MyParser Double
pFloat = do
        String
i <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
        String
d <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"0" (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
        String
e <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"0" (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
                                    String
s <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
"-")
                                    String
e' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
sforall a. [a] -> [a] -> [a]
++String
e')
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read (String
iforall a. [a] -> [a] -> [a]
++String
"."forall a. [a] -> [a] -> [a]
++String
dforall a. [a] -> [a] -> [a]
++String
"e"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
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
  Double
d <- MyParser Double
pInteger
  if (forall a. RealFrac a => a -> Bool
isInt a
n)
    then forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a b. (RealFrac a, Integral b) => a -> b
round a
n) forall a. Integral a => a -> a -> Ratio a
% (forall a b. (RealFrac a, Integral b) => a -> b
round Double
d))
    else 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 = forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'w' a
1
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'h' a
0.5
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'q' a
0.25
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'e' a
0.125
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
's' a
0.0625
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
't' (a
1forall a. Fractional a => a -> a -> a
/a
3)
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'f' a
0.2
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. Fractional a => Char -> a -> MyParser a
pRatioSingleChar Char
'x' (a
1forall 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 = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
  forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter)
  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 forall a. Eq a => a -> a -> Bool
== forall a. Num a => Integer -> a
fromInteger (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 = 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 = forall a. [a] -> Pattern a
fastFromList [[Modifier]
a,[Modifier]
b]
  fromThenTo :: [Modifier] -> [Modifier] -> [Modifier] -> Pattern [Modifier]
fromThenTo [Modifier]
a [Modifier]
b [Modifier]
c = forall a. [a] -> Pattern a
fastFromList [[Modifier]
a,[Modifier]
b,[Modifier]
c]

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

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

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

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

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

parseModifiers :: MyParser [Modifier]
parseModifiers :: MyParser [Modifier]
parseModifiers = (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 MyParser Modifier
parseModOpen) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser [Modifier]
parseModDrop forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure MyParser Modifier
parseModRange) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try MyParser [Modifier]
parseModInvNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 MyParser Modifier
parseModInv)  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 = forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos forall a b. (a -> b) -> a -> b
$ forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom forall a. Maybe a
Nothing 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
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
    TPat String
n <- forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat String)
pVocable forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"chordname"
    [TPat [Modifier]]
ms <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat [Modifier])
pModifiers)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a.
(Num b, Enum b, Parseable b, Enumerable b) =>
(b -> a) -> TPat b -> TPat String -> [TPat [Modifier]] -> TPat a
TPat_Chord forall a. a -> a
id TPat a
i TPat String
n [TPat [Modifier]]
ms