{-# LANGUAGE OverloadedStrings, FlexibleInstances, CPP, DeriveFunctor #-}
{-# 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 (chordTable)
import           Sound.Tidal.Utils (fromRight)

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

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

-- | AST representation of patterns

data TPat a = 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)
            | TPat_Var String
            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, a -> TPat b -> TPat a
(a -> b) -> TPat a -> TPat b
(forall a b. (a -> b) -> TPat a -> TPat b)
-> (forall a b. a -> TPat b -> TPat a) -> Functor TPat
forall a b. a -> TPat b -> TPat a
forall a b. (a -> b) -> TPat a -> TPat b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TPat b -> TPat a
$c<$ :: forall a b. a -> TPat b -> TPat a
fmap :: (a -> b) -> TPat a -> TPat b
$cfmap :: forall a b. (a -> b) -> TPat a -> TPat b
Functor)

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

tShow :: (Show a) => TPat a -> String
tShow :: TPat a -> String
tShow (TPat_Atom Maybe ((Int, Int), (Int, Int))
_ a
v) = String
"pure " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v
tShow (TPat_Fast TPat Time
t TPat a
v) = String
"fast " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Time -> String
forall a. Show a => a -> String
show TPat Time
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
tShow (TPat_Slow TPat Time
t TPat a
v) = String
"slow " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat Time -> String
forall a. Show a => a -> String
show TPat Time
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
-- TODO - should be _degradeByUsing, but needs a simplified version..
tShow (TPat_DegradeBy Int
_ Double
r TPat a
v) = String
"degradeBy " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
-- TODO - ditto
tShow (TPat_CycleChoose Int
_ [TPat a]
vs) = String
"cycleChoose " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => [TPat a] -> String
tShowList [TPat a]
vs

tShow (TPat_Euclid TPat Int
a TPat Int
b TPat Int
c TPat a
v) = String
"doEuclid (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
") (" ((TPat Int -> String) -> [TPat Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TPat Int -> String
forall a. Show a => TPat a -> String
tShow [TPat Int
a,TPat Int
b,TPat Int
c])  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") $ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
v
tShow (TPat_Stack [TPat a]
vs) = String
"stack " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TPat a] -> String
forall a. Show a => [TPat a] -> String
tShowList [TPat a]
vs

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

tShow (TPat_Seq [TPat a]
vs) = (Time, String) -> String
forall a b. (a, b) -> b
snd ((Time, String) -> String) -> (Time, String) -> String
forall a b. (a -> b) -> a -> b
$ [TPat a] -> (Time, String)
forall a. Show a => [TPat a] -> (Time, String)
steps_seq [TPat a]
vs

tShow TPat a
TPat_Silence = String
"silence"
tShow (TPat_EnumFromTo TPat a
a TPat a
b) = String
"unwrap $ fromTo <$> (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") <*> (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => TPat a -> String
tShow TPat a
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
tShow (TPat_Var String
s) = String
"getControl " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
tShow TPat a
a = String
"can't happen? " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TPat a -> String
forall a. Show a => a -> String
show TPat a
a


toPat :: (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat :: TPat a -> Pattern a
toPat = \case
   TPat_Atom (Just ((Int, Int), (Int, Int))
loc) a
x -> Context -> Pattern a -> Pattern a
forall a. Context -> Pattern a -> Pattern a
setContext ([((Int, Int), (Int, Int))] -> Context
Context [((Int, Int), (Int, Int))
loc]) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
   TPat_Atom Maybe ((Int, Int), (Int, Int))
Nothing a
x -> a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
   TPat_Fast TPat Time
t 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 TPat Time
t 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 Int
seed Double
amt 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 (Time
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 Int
seed [TPat a]
xs -> Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern Time -> Pattern (Pattern a) -> Pattern (Pattern a)
forall a. Pattern Time -> Pattern a -> Pattern a
segment Pattern Time
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 (Time
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 TPat Int
n TPat Int
k TPat Int
s TPat a
thing -> Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
forall a.
Parseable a =>
Pattern Int -> Pattern Int -> Pattern Int -> Pattern a -> Pattern a
doEuclid (TPat Int -> Pattern Int
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
n) (TPat Int -> Pattern Int
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
k) (TPat Int -> Pattern Int
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat Int
s) (TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
thing)
   TPat_Stack [TPat a]
xs -> [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (TPat a -> Pattern a) -> [TPat a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat [TPat a]
xs
   TPat a
TPat_Silence -> Pattern a
forall a. Pattern a
silence
   TPat_EnumFromTo TPat a
a TPat a
b -> Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
unwrap (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ a -> a -> Pattern a
forall a. Enumerable a => a -> a -> Pattern a
fromTo (a -> a -> Pattern a) -> Pattern a -> Pattern (a -> Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
a Pattern (a -> Pattern a) -> Pattern a -> Pattern (Pattern a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TPat a -> Pattern a
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat TPat a
b
   TPat a
TPat_Foot -> String -> Pattern a
forall a. HasCallStack => String -> a
error String
"Can't happen, feet are pre-processed."
   TPat_Polyrhythm Maybe (TPat Time)
mSteprate [TPat a]
ps -> [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ ((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 (Time
sz, 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
-> (TPat Time -> Pattern Time) -> Maybe (TPat Time) -> Pattern Time
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pattern Time
base_first TPat Time -> Pattern Time
forall a. (Parseable a, Enumerable a) => TPat a -> Pattern a
toPat 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 Time
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 [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
   TPat_Var String
s -> String -> Pattern a
forall a. Parseable a => String -> Pattern a
getControl String
s
   TPat a
_ -> 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 [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 TPat a
a = (Time
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 [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 Time
r TPat a
p):[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 Int
n TPat a
p):[TPat a]
ps) = Int -> (Time, TPat a) -> [(Time, TPat a)]
forall a. Int -> a -> [a]
replicate Int
n (Time
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 (TPat a
p:[TPat a]
ps) = (Time
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


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

steps_seq :: (Show a) => [TPat a] -> (Rational, String)
steps_seq :: [TPat a] -> (Time, String)
steps_seq [TPat a]
xs = (Time
total_size, String
"timeCat [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (((Time, String) -> String) -> [(Time, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Time
r,String
s) -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Time -> String
forall a. Show a => a -> String
show Time
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") [(Time, String)]
sized_pats) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]")
  where sized_pats :: [(Time, String)]
sized_pats = [TPat a] -> [(Time, String)]
forall a. Show a => [TPat a] -> [(Time, String)]
steps_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, String) -> Time) -> [(Time, String)] -> [Time]
forall a b. (a -> b) -> [a] -> [b]
map (Time, String) -> Time
forall a b. (a, b) -> a
fst [(Time, String)]
sized_pats

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

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

parseBP_E :: (Enumerable a, Parseable a) => String -> Pattern a
parseBP_E :: String -> Pattern a
parseBP_E 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 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 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 = GenParser Char Int (TPat a)
-> Int -> String -> String -> Either ParseError (TPat a)
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser (GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence GenParser Char Int (TPat a)
f' GenParser Char Int (TPat a)
-> ParsecT String Int Identity () -> GenParser Char Int (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) (Int
0 :: Int) String
""
  where f' :: GenParser Char Int (TPat a)
f' = do GenParser Char Int (TPat a)
forall a. Parseable a => MyParser (TPat a)
tPatParser
             GenParser Char Int (TPat a)
-> GenParser Char Int (TPat a) -> GenParser Char Int (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do String -> MyParser String
symbol String
"~" MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"rest"
                    TPat a -> GenParser Char Int (TPat a)
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
forall a. TPat a
TPat_Silence

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Parseable Rational where
  tPatParser :: MyParser (TPat 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
  getControl :: String -> Pattern Time
getControl = String -> Pattern Time
cR_

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
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
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 ColourD
a ColourD
b = [ColourD] -> Pattern ColourD
forall a. [a] -> Pattern a
fastFromList [ColourD
a,ColourD
b]
  fromThenTo :: ColourD -> ColourD -> ColourD -> Pattern ColourD
fromThenTo ColourD
a ColourD
b ColourD
c = [ColourD] -> Pattern ColourD
forall a. [a] -> Pattern a
fastFromList [ColourD
a,ColourD
b,ColourD
c]

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

lexer :: P.GenTokenParser String u Data.Functor.Identity.Identity
lexer :: 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 Sign
Positive =  a -> a
forall a. a -> a
id
applySign Sign
Negative =  a -> a
forall a. Num a => a -> a
negate

sign  :: MyParser Sign
sign :: MyParser Sign
sign  =  do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
            Sign -> MyParser Sign
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Negative
         MyParser Sign -> MyParser Sign -> MyParser Sign
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
                Sign -> MyParser Sign
forall (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 = MyParser Double -> MyParser Double
forall tok st a. GenParser tok st a -> GenParser tok st a
try MyParser Double
pFloat MyParser Double -> MyParser Double -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser Double
pInteger

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

pRepeat :: TPat a -> MyParser (TPat a)
pRepeat :: TPat a -> MyParser (TPat a)
pRepeat TPat a
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 Char
'!'
                                Int
n <- (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> MyParser String -> 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 Int
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 (Int
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

pElongate :: TPat a -> MyParser (TPat a)
pElongate :: TPat a -> MyParser (TPat a)
pElongate TPat a
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 String
"@_"
                                  Time
r <- (Time -> Time -> Time
forall a. Num a => a -> a -> a
subtract Time
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 Time
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
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 (Time
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

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

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

pPart :: Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPart :: MyParser (TPat a) -> MyParser (TPat a)
pPart MyParser (TPat a)
f = (MyParser (TPat a) -> MyParser (TPat a)
forall a. MyParser (TPat a) -> MyParser (TPat a)
pSingle MyParser (TPat a)
f MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyIn MyParser (TPat a)
f MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pPolyOut MyParser (TPat a)
f MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MyParser (TPat a)
forall a. MyParser (TPat a)
pVar) MyParser (TPat a)
-> (TPat a -> MyParser (TPat a)) -> MyParser (TPat a)
forall (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

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
+Int
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 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
<?> String
"sequence"
                                  TPat a -> MyParser (TPat a)
stackTail TPat a
s MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> MyParser (TPat a)
chooseTail TPat a
s MyParser (TPat a) -> MyParser (TPat a) -> MyParser (TPat a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TPat a -> MyParser (TPat a)
forall (m :: * -> *) a. Monad m => a -> m a
return TPat a
s
               TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pMult TPat a
x
  where stackTail :: TPat a -> MyParser (TPat a)
stackTail TPat a
s = do String -> MyParser String
symbol String
","
                         [TPat a]
ss <- MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f MyParser (TPat a)
-> MyParser String -> ParsecT String Int Identity [TPat a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` String -> MyParser String
symbol String
","
                         TPat a -> MyParser (TPat a)
forall (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 TPat a
s = do String -> MyParser String
symbol String
"|"
                          [TPat a]
ss <- MyParser (TPat a) -> MyParser (TPat a)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat a)
f MyParser (TPat a)
-> MyParser String -> ParsecT String Int Identity [TPat a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` String -> MyParser String
symbol String
"|"
                          Int
seed <- 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 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 String
",")
                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 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
<?> String
"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 String
",")
                TPat a -> MyParser (TPat a)
forall a. TPat a -> MyParser (TPat a)
pMult (TPat a -> MyParser (TPat a)) -> TPat a -> MyParser (TPat a)
forall a b. (a -> b) -> a -> b
$ Maybe (TPat 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 Time
1) [TPat a]
ss

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

pString :: MyParser String
pString :: MyParser String
pString = do Char
c <- ParsecT String Int Identity Char
pCharNum ParsecT String Int Identity Char
-> String -> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"charnum"
             String
cs <- ParsecT String Int Identity Char -> MyParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
-> ParsecT String Int Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"0123456789:.-_") MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"string"
             String -> MyParser String
forall (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 MyParser (TPat a)
p = do SourcePos
b <- ParsecT String Int Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
               TPat a
tpat <- MyParser (TPat a)
p
               SourcePos
e <- ParsecT String Int Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
               let addPos :: TPat a -> TPat a
addPos (TPat_Atom Maybe ((Int, Int), (Int, Int))
_ a
v') =
                     Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom (((Int, Int), (Int, Int)) -> Maybe ((Int, Int), (Int, Int))
forall a. a -> Maybe a
Just ((SourcePos -> Int
sourceColumn SourcePos
b, SourcePos -> Int
sourceLine SourcePos
b), (SourcePos -> Int
sourceColumn SourcePos
e, SourcePos -> Int
sourceLine SourcePos
e))) a
v'
                   addPos TPat a
x = TPat a
x -- shouldn't happen..
               TPat a -> MyParser (TPat a)
forall (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 Sign
s <- MyParser Sign
sign
                       Double
f <- [MyParser Double] -> MyParser Double
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Time -> Double
forall a. Fractional a => Time -> a
fromRational (Time -> Double)
-> ParsecT String Int Identity Time -> MyParser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Time
pRatio, MyParser Double
forall a. Num a => MyParser a
parseNote] MyParser Double -> String -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float"
                       let v :: Double
v = Sign -> Double -> Double
forall a. Num a => Sign -> a -> a
applySign Sign
s Double
f
                       do [TPat Double] -> TPat Double
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat Double] -> TPat Double)
-> ([Double] -> [TPat Double]) -> [Double] -> TPat Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
v)) ([Double] -> TPat Double)
-> ParsecT String Int Identity [Double] -> MyParser (TPat Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity [Double]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                         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
v)
                       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 [TPat Double] -> TPat Double
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat Double] -> TPat Double)
-> ([Double] -> [TPat Double]) -> [Double] -> TPat Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> ParsecT String Int Identity [Double] -> MyParser (TPat Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity [Double]
forall a. (Enum a, Num a) => MyParser [a]
parseChord

pNote :: MyParser (TPat Note)
pNote :: MyParser (TPat Note)
pNote = MyParser (TPat Note) -> MyParser (TPat Note)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat Note) -> MyParser (TPat Note))
-> MyParser (TPat Note) -> MyParser (TPat Note)
forall a b. (a -> b) -> a -> b
$ (TPat Double -> TPat Note)
-> MyParser (TPat Double) -> MyParser (TPat Note)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Note) -> TPat Double -> TPat Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Note
Note) (MyParser (TPat Double) -> MyParser (TPat Note))
-> MyParser (TPat Double) -> MyParser (TPat Note)
forall a b. (a -> b) -> a -> b
$ do Sign
s <- MyParser Sign
sign
                                        Double
f <- [MyParser Double] -> MyParser Double
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [MyParser Double
intOrFloat, MyParser Double
forall a. Num a => MyParser a
parseNote] MyParser Double -> String -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float"
                                        let v :: Double
v = Sign -> Double -> Double
forall a. Num a => Sign -> a -> a
applySign Sign
s Double
f
                                        do [TPat Double] -> TPat Double
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat Double] -> TPat Double)
-> ([Double] -> [TPat Double]) -> [Double] -> TPat Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
v)) ([Double] -> TPat Double)
-> ParsecT String Int Identity [Double] -> MyParser (TPat Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity [Double]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                                           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
v)
                                     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 [TPat Double] -> TPat Double
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat Double] -> TPat Double)
-> ([Double] -> [TPat Double]) -> [Double] -> TPat Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> ParsecT String Int Identity [Double] -> MyParser (TPat Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity [Double]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                                     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 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) -> (Time -> Double) -> Time -> TPat Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Double
forall a. Fractional a => Time -> a
fromRational (Time -> TPat Double)
-> ParsecT String Int Identity Time -> MyParser (TPat Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity Time
pRatio

pBool :: MyParser (TPat Bool)
pBool :: MyParser (TPat Bool)
pBool = MyParser (TPat Bool) -> MyParser (TPat Bool)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat Bool) -> MyParser (TPat Bool))
-> MyParser (TPat Bool) -> MyParser (TPat Bool)
forall a b. (a -> b) -> a -> b
$ do String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"t1"
                     TPat Bool -> MyParser (TPat Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (TPat Bool -> MyParser (TPat Bool))
-> TPat Bool -> MyParser (TPat Bool)
forall a b. (a -> b) -> a -> b
$ Maybe ((Int, Int), (Int, Int)) -> Bool -> TPat Bool
forall a. Maybe ((Int, Int), (Int, Int)) -> a -> TPat a
TPat_Atom Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing Bool
True
                  MyParser (TPat Bool)
-> MyParser (TPat Bool) -> MyParser (TPat Bool)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  do String -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"f0"
                     TPat Bool -> MyParser (TPat Bool)
forall (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
                  Double
d <- [MyParser Double] -> MyParser Double
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [MyParser Double
intOrFloat, MyParser Double
forall a. Num a => MyParser a
parseNote]
                  if Double -> Bool
forall a. RealFrac a => a -> Bool
isInt Double
d
                    then i -> MyParser i
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> MyParser i) -> i -> MyParser i
forall a b. (a -> b) -> a -> b
$ Sign -> i -> i
forall a. Num a => Sign -> a -> a
applySign Sign
s (i -> i) -> i -> i
forall a b. (a -> b) -> a -> b
$ Double -> i
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d
                    else String -> MyParser i
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not an integer"

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 [TPat a] -> TPat a
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat a] -> TPat a) -> ([a] -> [TPat a]) -> [a] -> TPat a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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] -> TPat a)
-> ParsecT String Int Identity [a] -> MyParser (TPat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity [a]
forall a. (Enum a, Num a) => MyParser [a]
parseChord
                           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 [TPat a] -> TPat a
forall a. [TPat a] -> TPat a
TPat_Stack ([TPat a] -> TPat a) -> ([a] -> [TPat a]) -> [a] -> TPat a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> ParsecT String Int Identity [a] -> MyParser (TPat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Int Identity [a]
forall a. (Enum a, Num a) => MyParser [a]
parseChord

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 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 [a
0] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ String -> [(String, [a])] -> Maybe [a]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, [a])]
forall a. Num a => [(String, [a])]
chordTable
                do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
                   ParsecT String Int Identity Char -> ParsecT String Int Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT String Int Identity ()
-> String -> ParsecT String Int Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"chord range or 'i' or 'o'"
                   let n :: Int
n = [a] -> Int
forall (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 Char
'i')
                   Int
o <- 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 Char
'o')
                   let chord' :: [a]
chord' = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
j ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
+ a
x) [a]
chord) [a
0,a
12..]
                   -- open voiced chords
                   let chordo' :: [a]
chordo' = if Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then
                                     [ ([a]
chord' [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
0 a -> a -> a
forall a. Num a => a -> a -> a
- a
12), ([a]
chord' [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
2 a -> a -> a
forall a. Num a => a -> a -> a
- a
12), ([a]
chord' [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
1) ] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
chord' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
chord'))
                                 else [a]
chord'
                   [a] -> MyParser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
chordo'
                  MyParser [a] -> MyParser [a] -> MyParser [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> MyParser [a]
forall (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 Integer
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
-Integer
5)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
12)
  where
        notenum :: MyParser Integer
        notenum :: MyParser Integer
notenum = [MyParser Integer] -> MyParser Integer
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'd' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
2,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
4,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
5,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'g' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
7,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'a' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
9,
                          Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'b' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
11
                         ]
        noteModifier :: MyParser Integer
        noteModifier :: MyParser Integer
noteModifier = [MyParser Integer] -> MyParser Integer
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
's' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1,
                               Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1),
                               Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'n' ParsecT String Int Identity Char
-> MyParser Integer -> MyParser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> MyParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
                              ]

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

pColour :: MyParser (TPat ColourD)
pColour :: MyParser (TPat ColourD)
pColour = MyParser (TPat ColourD) -> MyParser (TPat ColourD)
forall a. MyParser (TPat a) -> MyParser (TPat a)
wrapPos (MyParser (TPat ColourD) -> MyParser (TPat ColourD))
-> MyParser (TPat ColourD) -> MyParser (TPat ColourD)
forall a b. (a -> b) -> a -> b
$ do String
name <- ParsecT String Int Identity Char -> MyParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Int Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter MyParser String -> String -> MyParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"colour name"
                       ColourD
colour <- String -> ParsecT String Int Identity ColourD
forall (m :: * -> *) a.
(MonadFail m, Monad m, Ord a, Floating a) =>
String -> m (Colour a)
readColourName String
name ParsecT String Int Identity ColourD
-> String -> ParsecT String Int Identity ColourD
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"known colour"
                       TPat ColourD -> MyParser (TPat ColourD)
forall (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 TPat a
thing = do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
                 ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                 TPat 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 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 TPat a
thing = do Char -> ParsecT String Int Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?'
                 Double
r <- MyParser Double
float MyParser Double -> MyParser Double -> MyParser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Double -> MyParser Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
0.5
                 ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                 Int
seed <- 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 TPat a
thing = do (TPat Int
n,TPat Int
k,TPat Int
s) <- MyParser (TPat Int, TPat Int, TPat Int)
-> MyParser (TPat Int, TPat Int, TPat Int)
forall a.
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 String
","
                   ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                   TPat Int
b <- MyParser (TPat Int) -> MyParser (TPat Int)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat Int)
forall a. Integral a => MyParser (TPat a)
pIntegral
                   TPat Int
c <- do String -> MyParser String
symbol String
","
                           ParsecT String Int Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                           MyParser (TPat Int) -> MyParser (TPat Int)
forall a. Parseable a => MyParser (TPat a) -> MyParser (TPat a)
pSequence MyParser (TPat Int)
forall a. Integral a => 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 Int
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)

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

pRatio :: MyParser Rational
pRatio :: ParsecT String Int Identity Time
pRatio = do
  Sign
s <- MyParser Sign
sign
  Time
r <- do Double
n <- MyParser Double -> MyParser Double
forall tok st a. GenParser tok st a -> GenParser tok st a
try MyParser Double
intOrFloat
          Time
v <- Double -> ParsecT String Int Identity Time
forall a. RealFrac a => a -> ParsecT String Int Identity Time
pFraction Double
n 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 (Double -> Time
forall a. Real a => a -> Time
toRational Double
n)
          Time
r <- 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 Time
1
          Time -> ParsecT String Int Identity Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Time
v Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
r)
       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
  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
r

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

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

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

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

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

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