{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-warn-unused-do-bind #-}

module Sound.Tidal.ParseBP where

import           Control.Applicative ((<$>), (<*>), pure)
import qualified Control.Exception as E
import           Data.Colour
import           Data.Colour.Names
import           Data.Functor.Identity (Identity)
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 (chordTable)

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
/= :: 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 err :: TidalParseError
err = "Syntax error in sequence:\n  \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TidalParseError -> String
code TidalParseError
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"\n  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pointer String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  " 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) ' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ "^"
          message :: String
message = String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "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 = TPat_Atom (Maybe ((Int, Int), (Int, Int))) a
            | TPat_Fast (TPat Time) (TPat a)
            | TPat_Slow (TPat Time) (TPat a)
            | TPat_DegradeBy Int Double (TPat a)
            | TPat_CycleChoose Int [TPat a]
            | TPat_Euclid (TPat Int) (TPat Int) (TPat Int) (TPat a)
            | TPat_Stack [TPat a]
            | TPat_Polyrhythm (Maybe (TPat Rational)) [TPat a]
            | TPat_Seq [TPat a]
            | TPat_Silence
            | TPat_Foot
            | TPat_Elongate Rational (TPat a)
            | TPat_Repeat Int (TPat a)
            | TPat_EnumFromTo (TPat a) (TPat a)
            deriving (Int -> TPat a -> ShowS
[TPat a] -> ShowS
TPat a -> String
(Int -> TPat a -> ShowS)
-> (TPat a -> String) -> ([TPat a] -> ShowS) -> Show (TPat a)
forall a. Show a => Int -> TPat a -> ShowS
forall a. Show a => [TPat a] -> ShowS
forall a. Show a => TPat a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TPat a] -> ShowS
$cshowList :: forall a. Show a => [TPat a] -> ShowS
show :: TPat a -> String
$cshow :: forall a. Show a => TPat a -> String
showsPrec :: Int -> TPat a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TPat a -> ShowS
Show)

toPat :: (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat :: TPat a -> Pattern a
toPat = \case
   TPat_Atom (Just loc :: ((Int, Int), (Int, Int))
loc) x :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure a
x
   TPat_Atom Nothing x :: a
x -> a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
   TPat_Fast t :: TPat Time
t x :: TPat a
x -> Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
fast (TPat Time -> Pattern Time
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Time
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 t :: TPat Time
t x :: TPat a
x -> Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
slow (TPat Time -> Pattern Time
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Time
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 seed :: Int
seed amt :: Double
amt x :: TPat a
x -> Pattern Double -> Double -> Pattern a -> Pattern a
forall a. Pattern Double -> Double -> Pattern a -> Pattern a
_degradeByUsing (Time -> Pattern Double -> Pattern Double
forall a. Time -> Pattern a -> Pattern a
rotL (0.0001 Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Int -> Time
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 seed :: Int
seed xs :: [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 Time -> Pattern (Pattern a) -> Pattern (Pattern a)
forall a. Pattern Time -> Pattern a -> Pattern a
segment 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 (Time -> Pattern Double -> Pattern Double
forall a. Time -> Pattern a -> Pattern a
rotL (0.0001 Time -> Time -> Time
forall a. Num a => a -> a -> a
* (Int -> Time
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 n :: TPat Int
n k :: TPat Int
k s :: TPat Int
s thing :: 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 xs :: [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_Silence -> Pattern a
forall a. Pattern a
silence
   TPat_EnumFromTo a :: TPat a
a b :: 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 (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_Foot -> String -> Pattern a
forall a. HasCallStack => String -> a
error "Can't happen, feet are pre-processed."
   TPat_Polyrhythm mSteprate :: Maybe (TPat Time)
mSteprate ps :: [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
$ ((Time, Pattern a) -> Pattern a)
-> [(Time, Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (Time, Pattern a) -> Pattern a
forall a. (Time, Pattern a) -> Pattern a
adjust_speed [(Time, Pattern a)]
pats
     where adjust_speed :: (Time, Pattern a) -> Pattern a
adjust_speed (sz :: Time
sz, pat :: Pattern a
pat) = Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
fast ((Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
sz) (Time -> Time) -> Pattern Time -> Pattern Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Time
steprate) Pattern a
pat
           pats :: [(Time, Pattern a)]
pats = (TPat a -> (Time, Pattern a)) -> [TPat a] -> [(Time, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map TPat a -> (Time, Pattern a)
forall a.
(Enumerable a, Parseable a) =>
TPat a -> (Time, Pattern a)
resolve_tpat [TPat a]
ps
           steprate :: Pattern Rational
           steprate :: Pattern Time
steprate = Pattern Time -> Maybe (Pattern Time) -> Pattern Time
forall a. a -> Maybe a -> a
fromMaybe Pattern Time
base_first (TPat Time -> Pattern Time
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat (TPat Time -> Pattern Time)
-> Maybe (TPat Time) -> Maybe (Pattern Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TPat Time)
mSteprate)
           base_first :: Pattern Time
base_first | [(Time, Pattern a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Time, Pattern a)]
pats = Time -> Pattern Time
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
                      | Bool
otherwise = Time -> Pattern Time
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> Pattern Time) -> Time -> Pattern Time
forall a b. (a -> b) -> a -> b
$ (Time, Pattern a) -> Time
forall a b. (a, b) -> a
fst ((Time, Pattern a) -> Time) -> (Time, Pattern a) -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, Pattern a)] -> (Time, Pattern a)
forall a. [a] -> a
head [(Time, Pattern a)]
pats
   TPat_Seq xs :: [TPat a]
xs -> (Time, Pattern a) -> Pattern a
forall a b. (a, b) -> b
snd ((Time, Pattern a) -> Pattern a) -> (Time, Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ [TPat a] -> (Time, Pattern a)
forall a.
(Enumerable a, Parseable a) =>
[TPat a] -> (Time, Pattern a)
resolve_seq [TPat a]
xs
   _ -> Pattern a
forall a. Pattern a
silence

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

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

{-
durations :: [TPat a] -> [(Int, TPat a)]
durations [] = []
durations (TPat_Elongate n : xs) = (n, TPat_Silence) : durations xs
durations (a : TPat_Elongate n : xs) = (n+1,a) : durations xs
durations (a:xs) = (1,a) : durations xs
-}

parseBP :: (Enumerable a, Parseable a) => String -> Either ParseError (Pattern a)
parseBP :: String -> Either ParseError (Pattern a)
parseBP s :: 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 :: String -> Pattern a
parseBP_E s :: String
s = Either ParseError (TPat a) -> Pattern a
forall a.
(Parseable a, Enumerable a) =>
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 e :: 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 :: ParseError -> String -> TidalParseError
TidalParseError {parsecError :: ParseError
parsecError = ParseError
e, code :: String
code = String
s}
    toE (Right tp :: 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 :: String -> Either ParseError (TPat a)
parseTPat = MyParser (TPat a) -> String -> Either ParseError (TPat a)
forall a.
Parseable a =>
MyParser (TPat a) -> String -> Either ParseError (TPat a)
parseRhythm MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a)
tPatParser

class Parseable a where
  tPatParser :: MyParser (TPat a)
  doEuclid :: Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
  -- toEuclid :: a ->

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 a :: Char
a b :: Char
b c :: 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

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

instance Enumerable String where
  fromTo :: String -> String -> Pattern String
fromTo a :: String
a b :: String
b = [String] -> Pattern String
forall a. [a] -> Pattern a
fastFromList [String
a,String
b]
  fromThenTo :: String -> String -> String -> Pattern String
fromThenTo a :: String
a b :: String
b c :: 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

instance Enumerable Bool where
  fromTo :: Bool -> Bool -> Pattern Bool
fromTo a :: Bool
a b :: Bool
b = [Bool] -> Pattern Bool
forall a. [a] -> Pattern a
fastFromList [Bool
a,Bool
b]
  fromThenTo :: Bool -> Bool -> Bool -> Pattern Bool
fromThenTo a :: Bool
a b :: Bool
b c :: 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 => 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

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 => 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

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 Time)
tPatParser = MyParser (TPat Time)
pRational
  doEuclid :: Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Time -> Pattern Time
doEuclid = Pattern Int
-> Pattern Int -> Pattern Int -> Pattern Time -> Pattern Time
forall a.
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
euclidOff

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

enumFromTo' :: (Ord a, Enum a) => a -> a -> Pattern a
enumFromTo' :: a -> a -> Pattern a
enumFromTo' a :: a
a b :: 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' :: a -> a -> a -> Pattern a
enumFromThenTo' a :: a
a b :: a
b c :: 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
aa -> 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 a :: ColourD
a b :: ColourD
b = [ColourD] -> Pattern ColourD
forall a. [a] -> Pattern a
fastFromList [ColourD
a,ColourD
b]
  fromThenTo :: ColourD -> ColourD -> ColourD -> Pattern ColourD
fromThenTo a :: ColourD
a b :: ColourD
b c :: 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

--instance (Parseable a, Pattern p) => IsString (p a) where
--  fromString = p :: String -> p a

lexer :: P.GenTokenParser String u Data.Functor.Identity.Identity
lexer :: 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 :: MyParser a -> MyParser a
braces  = GenTokenParser String Int Identity
-> forall a.
   ParsecT String Int Identity a -> ParsecT String Int Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.braces GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer
brackets :: MyParser a -> MyParser a
brackets = GenTokenParser String Int Identity
-> forall a.
   ParsecT String Int Identity a -> ParsecT String Int Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.brackets GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer
parens :: MyParser a -> MyParser a
parens = GenTokenParser String Int Identity
-> forall a.
   ParsecT String Int Identity a -> ParsecT String Int Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.parens GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer
angles :: MyParser a -> MyParser a
angles = GenTokenParser String Int Identity
-> forall a.
   ParsecT String Int Identity a -> ParsecT String Int Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.angles GenTokenParser String Int Identity
forall u. GenTokenParser String u Identity
lexer

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 :: Sign -> a -> a
applySign Positive =  a -> a
forall a. a -> a
id
applySign 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 '-'
            Sign -> MyParser Sign
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 '+'
                Sign -> MyParser Sign
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 (m :: * -> *) a. Monad m => a -> m a
return Sign
Positive

intOrFloat :: MyParser Double
intOrFloat :: MyParser Double
intOrFloat =  do Sign
s   <- MyParser Sign
sign
                 Either Integer Double
num <- MyParser (Either Integer Double)
naturalOrFloat
                 Double -> MyParser Double
forall (m :: * -> *) a. Monad m => a -> m a
return (case Either Integer Double
num of
                            Right x :: Double
x -> Sign -> Double -> Double
forall a. Num a => Sign -> a -> a
applySign Sign
s Double
x
                            Left  x :: Integer
x -> Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Sign -> Integer -> Integer
forall a. Num a => Sign -> a -> a
applySign Sign
s Integer
x
                        )

parseRhythm :: Parseable a => MyParser (TPat a) -> String -> Either ParseError (TPat a)
parseRhythm :: MyParser (TPat a) -> String -> Either ParseError (TPat a)
parseRhythm f :: MyParser (TPat a)
f = MyParser (TPat a)
-> Int -> String -> String -> Either ParseError (TPat a)
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser (MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f' MyParser (TPat a)
-> ParsecT String Int Identity () -> MyParser (TPat a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
Prelude.<* ParsecT String Int Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) (0 :: Int) ""
  where f' :: MyParser (TPat a)
f' = do 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
<|> do String -> MyParser String
symbol "~" MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "rest"
                       TPat a -> MyParser (TPat a)
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
forall a. TPat a
TPat_Silence

pSequence :: Parseable a => MyParser (TPat a) -> GenParser Char Int (TPat a)
pSequence :: MyParser (TPat a) -> MyParser (TPat a)
pSequence f :: MyParser (TPat a)
f = do ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces -- TODO is this needed?
                 -- d <- pFast
                 [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
                                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 ".."
                                   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 (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
                                 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 [Time]
rs <- ParsecT String Int Identity Time
-> ParsecT String Int Identity [Time]
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 Time
 -> ParsecT String Int Identity [Time])
-> ParsecT String Int Identity Time
-> ParsecT String Int Identity [Time]
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 "@_"
                                                         Time
r <- ((Time -> Time -> Time
forall a. Num a => a -> a -> a
subtract 1) (Time -> Time)
-> ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Time
pRatio) ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return 1
                                                         ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                                                         Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> ParsecT String Int Identity Time)
-> Time -> ParsecT String Int Identity Time
forall a b. (a -> b) -> a -> b
$ Time
r
                                        TPat a -> MyParser (TPat 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
$ Time -> TPat a -> TPat a
forall a. Time -> TPat a -> TPat a
TPat_Elongate (1 Time -> Time -> Time
forall a. Num a => a -> a -> a
+ [Time] -> Time
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Time]
rs) 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
<|> do [Int]
es <- ParsecT String Int Identity 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 (ParsecT String Int Identity Int
 -> ParsecT String Int Identity [Int])
-> ParsecT String Int Identity 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 '!'
                                                         Int
n <- (((Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract 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 -> ParsecT String Int Identity 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) ParsecT String Int Identity Int
-> ParsecT String Int Identity Int
-> ParsecT String Int Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT String Int Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return 1
                                                         ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                                                         Int -> ParsecT String Int Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                                        TPat a -> MyParser (TPat 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 (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
es) 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 (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
<|> do String -> MyParser String
symbol "."
                                    TPat a -> MyParser (TPat a)
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
forall a. TPat a
TPat_Foot
                 TPat a -> MyParser (TPat 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
resolve_feet [TPat a]
s
      where resolve_feet :: [TPat a] -> TPat a
resolve_feet ps :: [TPat a]
ps | [[TPat a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[TPat a]]
ss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 :: [TPat t] -> [[TPat t]]
splitFeet [] = []
            splitFeet pats :: [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 (foot :: [TPat t]
foot, pats' :: [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_Foot:pats'' :: [TPat a]
pats'') = ([], [TPat a]
pats'')
                    takeFoot (pat :: TPat a
pat:pats'' :: [TPat a]
pats'') = (\(a :: [TPat a]
a,b :: [TPat a]
b) -> (TPat a
patTPat a -> [TPat a] -> [TPat a]
forall a. a -> [a] -> [a]
:[TPat a]
a,[TPat a]
b)) (([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''


pSingle :: MyParser (TPat a) -> MyParser (TPat a)
pSingle :: MyParser (TPat a) -> MyParser (TPat a)
pSingle f :: MyParser (TPat a)
f = MyParser (TPat a)
f MyParser (TPat a)
-> (TPat a -> MyParser (TPat a)) -> MyParser (TPat a)
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 (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

pPart :: Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart :: MyParser (TPat a) -> MyParser (TPat a)
pPart f :: MyParser (TPat a)
f = do TPat a
pt <- (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)
-> (TPat a -> MyParser (TPat a)) -> MyParser (TPat a)
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 (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
             ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces -- TODO is this needed?
             TPat a -> MyParser (TPat a)
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
pt

newSeed :: MyParser Int
newSeed :: ParsecT String Int Identity Int
newSeed = do Int
seed <- ParsecT String Int Identity 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
+1)
             Int -> ParsecT String Int Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
seed

pPolyIn :: Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn :: MyParser (TPat a) -> MyParser (TPat a)
pPolyIn f :: MyParser (TPat a)
f = do TPat a
x <- MyParser (TPat a) -> MyParser (TPat a)
forall a.
ParsecT String Int Identity a -> ParsecT String Int Identity a
brackets (MyParser (TPat a) -> MyParser (TPat a))
-> MyParser (TPat a) -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ 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
<?> "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 (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 s :: TPat a
s = do String -> MyParser String
symbol ","
                         [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 ","
                         ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces -- TODO needed?
                         TPat a -> MyParser (TPat 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
sTPat a -> [TPat a] -> [TPat a]
forall a. a -> [a] -> [a]
:[TPat a]
ss)
        chooseTail :: TPat a -> MyParser (TPat a)
chooseTail s :: TPat a
s = do String -> MyParser String
symbol "|"
                          [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 "|"
                          ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces -- TODO needed?
                          Int
seed <- ParsecT String Int Identity Int
newSeed
                          TPat a -> MyParser (TPat 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
sTPat a -> [TPat a] -> [TPat a]
forall a. a -> [a] -> [a]
:[TPat a]
ss)

pPolyOut :: Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut :: MyParser (TPat a) -> MyParser (TPat a)
pPolyOut f :: MyParser (TPat a)
f = do [TPat a]
ss <- MyParser [TPat a] -> MyParser [TPat a]
forall a.
ParsecT String Int Identity a -> ParsecT String Int Identity 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 ",")
                ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces -- TODO needed?
                Maybe (TPat Time)
base <- do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '%'
                           TPat Time
r <- MyParser (TPat Time) -> MyParser (TPat Time)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat Time)
pRational MyParser (TPat Time) -> String -> MyParser (TPat Time)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "rational number"
                           Maybe (TPat Time)
-> ParsecT String Int Identity (Maybe (TPat Time))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TPat Time)
 -> ParsecT String Int Identity (Maybe (TPat Time)))
-> Maybe (TPat Time)
-> ParsecT String Int Identity (Maybe (TPat Time))
forall a b. (a -> b) -> a -> b
$ TPat Time -> Maybe (TPat Time)
forall a. a -> Maybe a
Just TPat Time
r
                        ParsecT String Int Identity (Maybe (TPat Time))
-> ParsecT String Int Identity (Maybe (TPat Time))
-> ParsecT String Int Identity (Maybe (TPat Time))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe (TPat Time)
-> ParsecT String Int Identity (Maybe (TPat Time))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TPat Time)
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 Time) -> [TPat a] -> TPat a
forall a. Maybe (TPat Time) -> [TPat a] -> TPat a
TPat_Polyrhythm Maybe (TPat Time)
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.
ParsecT String Int Identity a -> ParsecT String Int Identity 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 ",")
                ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces -- TODO needed/wanted?
                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 Time) -> [TPat a] -> TPat a
forall a. Maybe (TPat Time) -> [TPat a] -> TPat a
TPat_Polyrhythm (TPat Time -> Maybe (TPat Time)
forall a. a -> Maybe a
Just (TPat Time -> Maybe (TPat Time)) -> TPat Time -> Maybe (TPat Time)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Time -> TPat Time
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing 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 "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
<?> "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
<?> "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 "0123456789:.-_") MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "string"
             String -> MyParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)

wrapPos :: MyParser (TPat a) -> MyParser (TPat a)
wrapPos :: MyParser (TPat a) -> MyParser (TPat a)
wrapPos p :: 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 _ v' :: 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 x :: TPat a
x = TPat a
x -- shouldn't happen..
               TPat a -> MyParser (TPat 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
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 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 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
<?> "float"
                       do [Double]
c <- MyParser [Double]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                          TPat Double -> MyParser (TPat Double)
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
$ [TPat Double] -> TPat Double
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat Double] -> TPat Double) -> [TPat Double] -> TPat Double
forall a b. (a -> b) -> a -> b
$ (Double -> TPat Double) -> [Double] -> [TPat Double]
forall a b. (a -> b) -> [a] -> [b]
map ((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 -> TPat Double)
-> (Double -> Double) -> Double -> TPat Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
f)) [Double]
c
                         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 (m :: * -> *) a. Monad m => a -> m a
return (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
f)
                      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
<|>
                         do [Double]
c <- MyParser [Double]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                            TPat Double -> MyParser (TPat Double)
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
$ [TPat Double] -> TPat Double
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat Double] -> TPat Double) -> [TPat Double] -> TPat Double
forall a b. (a -> b) -> a -> b
$ (Double -> TPat Double) -> [Double] -> [TPat Double]
forall a b. (a -> b) -> [a] -> [b]
map (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]
c
                      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
<|>
                         do Double
r <- MyParser Double
forall a. Fractional a => MyParser a
pRatioChar
                            TPat Double -> MyParser (TPat Double)
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 Double
r

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 "t1"
                     TPat Bool -> MyParser (TPat Bool)
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 "f0"
                     TPat Bool -> MyParser (TPat Bool)
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 :: MyParser i
parseIntNote = do Sign
s <- MyParser Sign
sign
                  Integer
i <- [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 [MyParser Integer
integer, MyParser Integer
forall a. Num a => MyParser a
parseNote]
                  i -> MyParser i
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
$ Integer -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i

parseInt :: MyParser Int
parseInt :: ParsecT String Int Identity Int
parseInt = do Sign
s <- MyParser Sign
sign
              Integer
i <- MyParser Integer
integer
              Int -> ParsecT String Int Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT String Int Identity Int)
-> Int -> ParsecT String Int Identity Int
forall a b. (a -> b) -> a -> b
$ Sign -> Int -> Int
forall a. Num a => Sign -> a -> a
applySign Sign
s (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i

pIntegral :: Integral a => MyParser (TPat a)
pIntegral :: MyParser (TPat a)
pIntegral = 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 a
i <- MyParser a
forall i. Integral i => MyParser i
parseIntNote
                         do [a]
c <- MyParser [a]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                            TPat a -> MyParser (TPat 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] -> TPat a) -> [TPat a] -> TPat a
forall a b. (a -> b) -> a -> b
$ (a -> TPat a) -> [a] -> [TPat a]
forall a b. (a -> b) -> [a] -> [b]
map ((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 -> TPat a) -> (a -> a) -> a -> TPat a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
+a
i)) [a]
c
                           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 (m :: * -> *) a. Monad m => a -> m a
return (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
i)
                      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 [a]
c <- MyParser [a]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                            TPat a -> MyParser (TPat 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] -> TPat a) -> [TPat a] -> TPat a
forall a b. (a -> b) -> a -> b
$ (a -> TPat a) -> [a] -> [TPat a]
forall a b. (a -> b) -> [a] -> [b]
map (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]
c

parseChord :: (Enum a, Num a) => MyParser [a]
parseChord :: 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 '\''
                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 chord :: [a]
chord = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [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 '\''
                   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
<?> "chord range or 'i'"
                   let n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
chord
                   Int
i <- Int
-> ParsecT String Int Identity Int
-> ParsecT String Int Identity 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 -> ParsecT String Int Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MyParser Integer
integer)
                   Int
j <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> MyParser String -> ParsecT String Int Identity 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 'i')
                   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 (\x :: 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]
chord) [0,12..]
                   [a] -> MyParser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
chord'
                  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 (m :: * -> *) a. Monad m => a -> m a
return [a]
chord

parseNote :: Num a => MyParser a
parseNote :: 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 5 MyParser Integer
natural
               let n' :: Integer
n' = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
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 (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
octaveInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-5)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*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 'c' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 0,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'd' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 2,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'e' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 4,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'f' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 5,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'g' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 7,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'a' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 9,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'b' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 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 's' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 1,
                               Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'f' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (-1),
                               Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'n' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return 0
                              ]

fromNote :: Num a => Pattern String -> Pattern a
fromNote :: Pattern String -> Pattern a
fromNote pat :: Pattern String
pat = (ParseError -> a) -> (a -> a) -> Either ParseError a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (a -> ParseError -> a
forall a b. a -> b -> a
const 0) a -> a
forall a. a -> a
id (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 0 "" (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
<?> "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
<?> "known colour"
                       TPat ColourD -> MyParser (TPat ColourD)
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 :: TPat a -> MyParser (TPat a)
pMult thing :: 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 '*'
                 ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                 TPat Time
r <- MyParser (TPat Time)
pRational MyParser (TPat Time)
-> MyParser (TPat Time) -> MyParser (TPat Time)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Time) -> MyParser (TPat Time)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat Time)
pRational MyParser (TPat Time)
-> MyParser (TPat Time) -> MyParser (TPat Time)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Time) -> MyParser (TPat Time)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat Time)
pRational
                 TPat a -> MyParser (TPat 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 Time -> TPat a -> TPat a
forall a. TPat Time -> TPat a -> TPat a
TPat_Fast TPat Time
r TPat a
thing
              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 Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/'
                 ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                 TPat Time
r <- MyParser (TPat Time)
pRational MyParser (TPat Time)
-> MyParser (TPat Time) -> MyParser (TPat Time)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Time) -> MyParser (TPat Time)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat Time)
pRational MyParser (TPat Time)
-> MyParser (TPat Time) -> MyParser (TPat Time)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat Time) -> MyParser (TPat Time)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat Time)
pRational
                 TPat a -> MyParser (TPat 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 Time -> TPat a -> TPat a
forall a. TPat Time -> TPat a -> TPat a
TPat_Slow TPat Time
r TPat a
thing
              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 (m :: * -> *) a. Monad m => a -> m a
return TPat a
thing

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

pE :: TPat a -> MyParser (TPat a)
pE :: TPat a -> MyParser (TPat a)
pE thing :: TPat a
thing = do (n :: TPat Int
n,k :: TPat Int
k,s :: TPat Int
s) <- MyParser (TPat Int, TPat Int, TPat Int)
-> MyParser (TPat Int, TPat Int, TPat Int)
forall a.
ParsecT String Int Identity a -> ParsecT String Int Identity a
parens MyParser (TPat Int, TPat Int, TPat Int)
pair
              TPat a -> MyParser (TPat a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (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
            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 (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 => 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 ","
                   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 => MyParser (TPat a)
pIntegral
                   TPat Int
c <- do String -> MyParser String
symbol ","
                           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 => 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 (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 0)
                   (TPat Int, TPat Int, TPat Int)
-> MyParser (TPat Int, TPat Int, TPat Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat Int
a, TPat Int
b, TPat Int
c)

pRatio :: MyParser Rational
pRatio :: ParsecT String Int Identity Time
pRatio = do Sign
s <- MyParser Sign
sign
            Integer
n <- String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> MyParser String -> MyParser Integer
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
            Time
result <- do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '%'
                         Integer
d <- MyParser Integer
decimal
                         Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
nInteger -> Integer -> Time
forall a. Integral a => a -> a -> Ratio a
%Integer
d)
                      ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
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 '.'
                         String
frac <- 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
                         -- A hack, but not sure if doing this
                         -- numerically would be any faster..
                         Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Time
forall a. Real a => a -> Time
toRational ((String -> Double
forall a. Read a => String -> a
read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ "." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
frac)  :: Double))
                      ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                      Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
nInteger -> Integer -> Time
forall a. Integral a => a -> a -> Ratio a
%1)
            Time
c <- (ParsecT String Int Identity Time
forall a. Fractional a => MyParser a
pRatioChar ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return 1)
            Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> ParsecT String Int Identity Time)
-> Time -> ParsecT String Int Identity Time
forall a b. (a -> b) -> a -> b
$ Sign -> Time -> Time
forall a. Num a => Sign -> a -> a
applySign Sign
s (Time
result Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
c)
         ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
-> ParsecT String Int Identity Time
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Int Identity Time
forall a. Fractional a => MyParser a
pRatioChar

pRatioChar :: Fractional a => MyParser a
pRatioChar :: MyParser a
pRatioChar = do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'w'
                a -> MyParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ 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
<|> do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'h'
                    a -> MyParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ 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
<|> do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'q'
                    a -> MyParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ 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
<|> do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'e'
                    a -> MyParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ 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
<|> do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 's'
                    a -> MyParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ 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
<|> do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 't'
                    a -> MyParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ 1a -> a -> a
forall a. Fractional 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
<|> do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'f'
                    a -> MyParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> MyParser a) -> a -> MyParser a
forall a b. (a -> b) -> a -> b
$ 0.2

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