-- Copyright 2018 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- deriving (Real) for Time emits this warning.
{-# OPTIONS_GHC -fno-warn-identities #-}
-- | Shared types for TScore.
module Derive.TScore.T where
import qualified Data.Ratio as Ratio
import qualified Data.String as String
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Util.Texts as Texts
import qualified Ui.Id as Id

import           Global


-- | This is the default "beat".
newtype Time = Time Ratio.Rational
    deriving (Eq Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmax :: Time -> Time -> Time
>= :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c< :: Time -> Time -> Bool
compare :: Time -> Time -> Ordering
$ccompare :: Time -> Time -> Ordering
Ord, Time -> Time -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq, Integer -> Time
Time -> Time
Time -> Time -> Time
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Time
$cfromInteger :: Integer -> Time
signum :: Time -> Time
$csignum :: Time -> Time
abs :: Time -> Time
$cabs :: Time -> Time
negate :: Time -> Time
$cnegate :: Time -> Time
* :: Time -> Time -> Time
$c* :: Time -> Time -> Time
- :: Time -> Time -> Time
$c- :: Time -> Time -> Time
+ :: Time -> Time -> Time
$c+ :: Time -> Time -> Time
Num, Int -> Time
Time -> Int
Time -> [Time]
Time -> Time
Time -> Time -> [Time]
Time -> Time -> Time -> [Time]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Time -> Time -> Time -> [Time]
$cenumFromThenTo :: Time -> Time -> Time -> [Time]
enumFromTo :: Time -> Time -> [Time]
$cenumFromTo :: Time -> Time -> [Time]
enumFromThen :: Time -> Time -> [Time]
$cenumFromThen :: Time -> Time -> [Time]
enumFrom :: Time -> [Time]
$cenumFrom :: Time -> [Time]
fromEnum :: Time -> Int
$cfromEnum :: Time -> Int
toEnum :: Int -> Time
$ctoEnum :: Int -> Time
pred :: Time -> Time
$cpred :: Time -> Time
succ :: Time -> Time
$csucc :: Time -> Time
Enum, Num Time
Ord Time
Time -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Time -> Rational
$ctoRational :: Time -> Rational
Real, Num Time
Rational -> Time
Time -> Time
Time -> Time -> Time
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Time
$cfromRational :: Rational -> Time
recip :: Time -> Time
$crecip :: Time -> Time
/ :: Time -> Time -> Time
$c/ :: Time -> Time -> Time
Fractional, Fractional Time
Real Time
forall b. Integral b => Time -> b
forall b. Integral b => Time -> (b, Time)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: forall b. Integral b => Time -> b
$cfloor :: forall b. Integral b => Time -> b
ceiling :: forall b. Integral b => Time -> b
$cceiling :: forall b. Integral b => Time -> b
round :: forall b. Integral b => Time -> b
$cround :: forall b. Integral b => Time -> b
truncate :: forall b. Integral b => Time -> b
$ctruncate :: forall b. Integral b => Time -> b
properFraction :: forall b. Integral b => Time -> (b, Time)
$cproperFraction :: forall b. Integral b => Time -> (b, Time)
RealFrac, [Time] -> Doc
Time -> Text
Time -> Doc
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [Time] -> Doc
$cformatList :: [Time] -> Doc
format :: Time -> Doc
$cformat :: Time -> Doc
pretty :: Time -> Text
$cpretty :: Time -> Text
Pretty)

instance Show Time where
    show :: Time -> String
show (Time Rational
t) = forall a. Pretty a => a -> String
prettys Rational
t

-- * Score

newtype Score = Score [(Pos, Toplevel)] deriving (Score -> Score -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Score -> Score -> Bool
$c/= :: Score -> Score -> Bool
== :: Score -> Score -> Bool
$c== :: Score -> Score -> Bool
Eq, Int -> Score -> ShowS
[Score] -> ShowS
Score -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Score] -> ShowS
$cshowList :: [Score] -> ShowS
show :: Score -> String
$cshow :: Score -> String
showsPrec :: Int -> Score -> ShowS
$cshowsPrec :: Int -> Score -> ShowS
Show)

data Toplevel =
    ToplevelDirective !Directive
    | BlockDefinition !(Block WrappedTracks)
    deriving (Toplevel -> Toplevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Toplevel -> Toplevel -> Bool
$c/= :: Toplevel -> Toplevel -> Bool
== :: Toplevel -> Toplevel -> Bool
$c== :: Toplevel -> Toplevel -> Bool
Eq, Int -> Toplevel -> ShowS
[Toplevel] -> ShowS
Toplevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Toplevel] -> ShowS
$cshowList :: [Toplevel] -> ShowS
show :: Toplevel -> String
$cshow :: Toplevel -> String
showsPrec :: Int -> Toplevel -> ShowS
$cshowsPrec :: Int -> Toplevel -> ShowS
Show)

-- | call is a parameter, because 'SubBlock' will later be resolved to
-- 'CallText'.
data Block tracks = Block {
    forall tracks. Block tracks -> BlockId
block_id :: !Id.BlockId
    , forall tracks. Block tracks -> [Directive]
block_directives :: ![Directive]
    , forall tracks. Block tracks -> Text
block_title :: !Text
    , forall tracks. Block tracks -> tracks
block_tracks :: !tracks
    } deriving (Block tracks -> Block tracks -> Bool
forall tracks. Eq tracks => Block tracks -> Block tracks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block tracks -> Block tracks -> Bool
$c/= :: forall tracks. Eq tracks => Block tracks -> Block tracks -> Bool
== :: Block tracks -> Block tracks -> Bool
$c== :: forall tracks. Eq tracks => Block tracks -> Block tracks -> Bool
Eq, Int -> Block tracks -> ShowS
forall tracks. Show tracks => Int -> Block tracks -> ShowS
forall tracks. Show tracks => [Block tracks] -> ShowS
forall tracks. Show tracks => Block tracks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block tracks] -> ShowS
$cshowList :: forall tracks. Show tracks => [Block tracks] -> ShowS
show :: Block tracks -> String
$cshow :: forall tracks. Show tracks => Block tracks -> String
showsPrec :: Int -> Block tracks -> ShowS
$cshowsPrec :: forall tracks. Show tracks => Int -> Block tracks -> ShowS
Show)

data WrappedTracks = WrappedTracks !Pos ![Tracks Call]
    deriving (WrappedTracks -> WrappedTracks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedTracks -> WrappedTracks -> Bool
$c/= :: WrappedTracks -> WrappedTracks -> Bool
== :: WrappedTracks -> WrappedTracks -> Bool
$c== :: WrappedTracks -> WrappedTracks -> Bool
Eq, Int -> WrappedTracks -> ShowS
[WrappedTracks] -> ShowS
WrappedTracks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WrappedTracks] -> ShowS
$cshowList :: [WrappedTracks] -> ShowS
show :: WrappedTracks -> String
$cshow :: WrappedTracks -> String
showsPrec :: Int -> WrappedTracks -> ShowS
$cshowsPrec :: Int -> WrappedTracks -> ShowS
Show)

newtype Tracks call = Tracks [Track call]
    deriving (Tracks call -> Tracks call -> Bool
forall call. Eq call => Tracks call -> Tracks call -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tracks call -> Tracks call -> Bool
$c/= :: forall call. Eq call => Tracks call -> Tracks call -> Bool
== :: Tracks call -> Tracks call -> Bool
$c== :: forall call. Eq call => Tracks call -> Tracks call -> Bool
Eq, Int -> Tracks call -> ShowS
forall call. Show call => Int -> Tracks call -> ShowS
forall call. Show call => [Tracks call] -> ShowS
forall call. Show call => Tracks call -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tracks call] -> ShowS
$cshowList :: forall call. Show call => [Tracks call] -> ShowS
show :: Tracks call -> String
$cshow :: forall call. Show call => Tracks call -> String
showsPrec :: Int -> Tracks call -> ShowS
$cshowsPrec :: forall call. Show call => Int -> Tracks call -> ShowS
Show)

untracks :: Tracks call -> [Track call]
untracks :: forall call. Tracks call -> [Track call]
untracks (Tracks [Track call]
tracks) = [Track call]
tracks

data Track call = Track {
    -- | Some arbitrary symbols.  This has no meaning except to make the track
    -- with its title unique on this block.  This is so that tracks have an
    -- identity, and I can detect track moves, adds, and deletes.
    forall call. Track call -> Text
track_key :: !Text
    -- | The track title will include a > if the original syntax did, or be ""
    -- if the track has no title at all, which is only possible for the first
    -- one, e.g. [a] or [a > b].  This way unparse can emit the same
    -- abbreviated syntax.
    , forall call. Track call -> Text
track_title :: !Text
    , forall call. Track call -> [Directive]
track_directives :: ![Directive]
    , forall call.
Track call -> [Token call (NPitch Pitch) NDuration Duration]
track_tokens :: ![Token call (NPitch Pitch) NDuration Duration]
    , forall call. Track call -> Pos
track_pos :: !Pos
    } deriving (Track call -> Track call -> Bool
forall call. Eq call => Track call -> Track call -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Track call -> Track call -> Bool
$c/= :: forall call. Eq call => Track call -> Track call -> Bool
== :: Track call -> Track call -> Bool
$c== :: forall call. Eq call => Track call -> Track call -> Bool
Eq, Int -> Track call -> ShowS
forall call. Show call => Int -> Track call -> ShowS
forall call. Show call => [Track call] -> ShowS
forall call. Show call => Track call -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Track call] -> ShowS
$cshowList :: forall call. Show call => [Track call] -> ShowS
show :: Track call -> String
$cshow :: forall call. Show call => Track call -> String
showsPrec :: Int -> Track call -> ShowS
$cshowsPrec :: forall call. Show call => Int -> Track call -> ShowS
Show)

data Directive = Directive !Pos !Text !(Maybe Text)
    deriving (Directive -> Directive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c== :: Directive -> Directive -> Bool
Eq, Int -> Directive -> ShowS
[Directive] -> ShowS
Directive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Directive] -> ShowS
$cshowList :: [Directive] -> ShowS
show :: Directive -> String
$cshow :: Directive -> String
showsPrec :: Int -> Directive -> ShowS
$cshowsPrec :: Int -> Directive -> ShowS
Show)

data Token call pitch ndur rdur =
    -- | Higher count for larger divisions, e.g. anga vs. avartanam.
    TBarline !Pos !Barline
    | TNote !Pos !(Note call pitch ndur)
    | TRest !Pos !(Rest rdur)
    deriving (Token call pitch ndur rdur -> Token call pitch ndur rdur -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall call pitch ndur rdur.
(Eq call, Eq pitch, Eq ndur, Eq rdur) =>
Token call pitch ndur rdur -> Token call pitch ndur rdur -> Bool
/= :: Token call pitch ndur rdur -> Token call pitch ndur rdur -> Bool
$c/= :: forall call pitch ndur rdur.
(Eq call, Eq pitch, Eq ndur, Eq rdur) =>
Token call pitch ndur rdur -> Token call pitch ndur rdur -> Bool
== :: Token call pitch ndur rdur -> Token call pitch ndur rdur -> Bool
$c== :: forall call pitch ndur rdur.
(Eq call, Eq pitch, Eq ndur, Eq rdur) =>
Token call pitch ndur rdur -> Token call pitch ndur rdur -> Bool
Eq, Int -> Token call pitch ndur rdur -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall call pitch ndur rdur.
(Show call, Show pitch, Show ndur, Show rdur) =>
Int -> Token call pitch ndur rdur -> ShowS
forall call pitch ndur rdur.
(Show call, Show pitch, Show ndur, Show rdur) =>
[Token call pitch ndur rdur] -> ShowS
forall call pitch ndur rdur.
(Show call, Show pitch, Show ndur, Show rdur) =>
Token call pitch ndur rdur -> String
showList :: [Token call pitch ndur rdur] -> ShowS
$cshowList :: forall call pitch ndur rdur.
(Show call, Show pitch, Show ndur, Show rdur) =>
[Token call pitch ndur rdur] -> ShowS
show :: Token call pitch ndur rdur -> String
$cshow :: forall call pitch ndur rdur.
(Show call, Show pitch, Show ndur, Show rdur) =>
Token call pitch ndur rdur -> String
showsPrec :: Int -> Token call pitch ndur rdur -> ShowS
$cshowsPrec :: forall call pitch ndur rdur.
(Show call, Show pitch, Show ndur, Show rdur) =>
Int -> Token call pitch ndur rdur -> ShowS
Show)

token_pos :: Token call pitch ndur rdur -> Pos
token_pos :: forall call pitch ndur rdur. Token call pitch ndur rdur -> Pos
token_pos = \case
    TBarline Pos
pos Barline
_ -> Pos
pos
    TNote Pos
pos Note call pitch ndur
_ -> Pos
pos
    TRest Pos
pos Rest rdur
_ -> Pos
pos

token_name :: Token call pitch ndur rdur -> Text
token_name :: forall call pitch ndur rdur. Token call pitch ndur rdur -> Text
token_name = \case
    TBarline {} -> Text
"barline"
    TNote {} -> Text
"note"
    TRest {} -> Text
"rest"

map_call :: (call1 -> call2)
    -> Token call1 pitch ndur rdur -> Token call2 pitch ndur rdur
map_call :: forall call1 call2 pitch ndur rdur.
(call1 -> call2)
-> Token call1 pitch ndur rdur -> Token call2 pitch ndur rdur
map_call call1 -> call2
f = \case
    TBarline Pos
pos Barline
a -> forall call pitch ndur rdur.
Pos -> Barline -> Token call pitch ndur rdur
TBarline Pos
pos Barline
a
    TNote Pos
pos Note call1 pitch ndur
note -> forall call pitch ndur rdur.
Pos -> Note call pitch ndur -> Token call pitch ndur rdur
TNote Pos
pos (Note call1 pitch ndur
note { note_call :: call2
note_call = call1 -> call2
f (forall call pitch dur. Note call pitch dur -> call
note_call Note call1 pitch ndur
note) })
    TRest Pos
pos Rest rdur
a -> forall call pitch ndur rdur.
Pos -> Rest rdur -> Token call pitch ndur rdur
TRest Pos
pos Rest rdur
a

map_pitch :: Applicative m => (pitch1 -> m pitch2)
    -> Token call pitch1 ndur rdur -> m (Token call pitch2 ndur rdur)
map_pitch :: forall (m :: * -> *) pitch1 pitch2 call ndur rdur.
Applicative m =>
(pitch1 -> m pitch2)
-> Token call pitch1 ndur rdur -> m (Token call pitch2 ndur rdur)
map_pitch pitch1 -> m pitch2
f = \case
    TBarline Pos
pos Barline
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall call pitch ndur rdur.
Pos -> Barline -> Token call pitch ndur rdur
TBarline Pos
pos Barline
a
    TNote Pos
pos Note call pitch1 ndur
note ->
        forall call pitch ndur rdur.
Pos -> Note call pitch ndur -> Token call pitch ndur rdur
TNote Pos
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\pitch2
a -> Note call pitch1 ndur
note { note_pitch :: pitch2
note_pitch = pitch2
a}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> pitch1 -> m pitch2
f (forall call pitch dur. Note call pitch dur -> pitch
note_pitch Note call pitch1 ndur
note)
    TRest Pos
pos Rest rdur
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall call pitch ndur rdur.
Pos -> Rest rdur -> Token call pitch ndur rdur
TRest Pos
pos Rest rdur
a

map_note_duration :: Applicative m => (dur1 -> m dur2)
    -> Token call pitch dur1 rdur -> m (Token call pitch dur2 rdur)
map_note_duration :: forall (m :: * -> *) dur1 dur2 call pitch rdur.
Applicative m =>
(dur1 -> m dur2)
-> Token call pitch dur1 rdur -> m (Token call pitch dur2 rdur)
map_note_duration dur1 -> m dur2
f = \case
    TBarline Pos
pos Barline
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall call pitch ndur rdur.
Pos -> Barline -> Token call pitch ndur rdur
TBarline Pos
pos Barline
a
    TNote Pos
pos Note call pitch dur1
note -> forall call pitch ndur rdur.
Pos -> Note call pitch ndur -> Token call pitch ndur rdur
TNote Pos
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\dur2
a -> Note call pitch dur1
note { note_duration :: dur2
note_duration = dur2
a }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        dur1 -> m dur2
f (forall call pitch dur. Note call pitch dur -> dur
note_duration Note call pitch dur1
note)
    TRest Pos
pos (Rest rdur
dur) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall call pitch ndur rdur.
Pos -> Rest rdur -> Token call pitch ndur rdur
TRest Pos
pos (forall dur. dur -> Rest dur
Rest rdur
dur)

map_note :: Applicative m
    => (Note call1 pitch1 ndur -> m (Note call2 pitch2 ndur))
    -> Token call1 pitch1 ndur rdur -> m (Token call2 pitch2 ndur rdur)
map_note :: forall (m :: * -> *) call1 pitch1 ndur call2 pitch2 rdur.
Applicative m =>
(Note call1 pitch1 ndur -> m (Note call2 pitch2 ndur))
-> Token call1 pitch1 ndur rdur -> m (Token call2 pitch2 ndur rdur)
map_note Note call1 pitch1 ndur -> m (Note call2 pitch2 ndur)
f = \case
    TBarline Pos
pos Barline
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall call pitch ndur rdur.
Pos -> Barline -> Token call pitch ndur rdur
TBarline Pos
pos Barline
a
    TNote Pos
pos Note call1 pitch1 ndur
note -> forall call pitch ndur rdur.
Pos -> Note call pitch ndur -> Token call pitch ndur rdur
TNote Pos
pos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Note call1 pitch1 ndur -> m (Note call2 pitch2 ndur)
f Note call1 pitch1 ndur
note
    TRest Pos
pos Rest rdur
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall call pitch ndur rdur.
Pos -> Rest rdur -> Token call pitch ndur rdur
TRest Pos
pos Rest rdur
a

-- | Opposite from Ruler.Rank, higher numbers mean larger divisions.
type Rank = Int

data Barline = Barline Rank | AssertCoincident
    deriving (Barline -> Barline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Barline -> Barline -> Bool
$c/= :: Barline -> Barline -> Bool
== :: Barline -> Barline -> Bool
$c== :: Barline -> Barline -> Bool
Eq, Int -> Barline -> ShowS
[Barline] -> ShowS
Barline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Barline] -> ShowS
$cshowList :: [Barline] -> ShowS
show :: Barline -> String
$cshow :: Barline -> String
showsPrec :: Int -> Barline -> ShowS
$cshowsPrec :: Int -> Barline -> ShowS
Show)

data Note call pitch dur = Note {
    forall call pitch dur. Note call pitch dur -> call
note_call :: !call
    , forall call pitch dur. Note call pitch dur -> pitch
note_pitch :: !pitch
    -- | The generated event should have 0 duration.
    , forall call pitch dur. Note call pitch dur -> Bool
note_zero_duration :: !Bool
    , forall call pitch dur. Note call pitch dur -> dur
note_duration :: !dur
    -- | This is redundant with 'TNote's Pos, but convenient, since Check will
    -- later strip away 'Token's.
    , forall call pitch dur. Note call pitch dur -> Pos
note_pos :: !Pos
    } deriving (Note call pitch dur -> Note call pitch dur -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall call pitch dur.
(Eq call, Eq pitch, Eq dur) =>
Note call pitch dur -> Note call pitch dur -> Bool
/= :: Note call pitch dur -> Note call pitch dur -> Bool
$c/= :: forall call pitch dur.
(Eq call, Eq pitch, Eq dur) =>
Note call pitch dur -> Note call pitch dur -> Bool
== :: Note call pitch dur -> Note call pitch dur -> Bool
$c== :: forall call pitch dur.
(Eq call, Eq pitch, Eq dur) =>
Note call pitch dur -> Note call pitch dur -> Bool
Eq, Int -> Note call pitch dur -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall call pitch dur.
(Show call, Show pitch, Show dur) =>
Int -> Note call pitch dur -> ShowS
forall call pitch dur.
(Show call, Show pitch, Show dur) =>
[Note call pitch dur] -> ShowS
forall call pitch dur.
(Show call, Show pitch, Show dur) =>
Note call pitch dur -> String
showList :: [Note call pitch dur] -> ShowS
$cshowList :: forall call pitch dur.
(Show call, Show pitch, Show dur) =>
[Note call pitch dur] -> ShowS
show :: Note call pitch dur -> String
$cshow :: forall call pitch dur.
(Show call, Show pitch, Show dur) =>
Note call pitch dur -> String
showsPrec :: Int -> Note call pitch dur -> ShowS
$cshowsPrec :: forall call pitch dur.
(Show call, Show pitch, Show dur) =>
Int -> Note call pitch dur -> ShowS
Show)

data Call = Call !CallText
    -- | A call can take multiple 'Tracks' arguments, each one of which is a
    -- sub-block.
    | SubBlock !CallText ![Tracks Call]
    deriving (Call -> Call -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Call -> Call -> Bool
$c/= :: Call -> Call -> Bool
== :: Call -> Call -> Bool
$c== :: Call -> Call -> Bool
Eq, Int -> Call -> ShowS
[Call] -> ShowS
Call -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Call] -> ShowS
$cshowList :: [Call] -> ShowS
show :: Call -> String
$cshow :: Call -> String
showsPrec :: Int -> Call -> ShowS
$cshowsPrec :: Int -> Call -> ShowS
Show)

instance String.IsString Call where
    fromString :: String -> Call
fromString = Text -> Call
Call forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
txt

-- | Tracklang expression.  This goes into the event text.
type CallText = Text

newtype Rest dur = Rest dur
    deriving (Rest dur -> Rest dur -> Bool
forall dur. Eq dur => Rest dur -> Rest dur -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rest dur -> Rest dur -> Bool
$c/= :: forall dur. Eq dur => Rest dur -> Rest dur -> Bool
== :: Rest dur -> Rest dur -> Bool
$c== :: forall dur. Eq dur => Rest dur -> Rest dur -> Bool
Eq, Int -> Rest dur -> ShowS
forall dur. Show dur => Int -> Rest dur -> ShowS
forall dur. Show dur => [Rest dur] -> ShowS
forall dur. Show dur => Rest dur -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rest dur] -> ShowS
$cshowList :: forall dur. Show dur => [Rest dur] -> ShowS
show :: Rest dur -> String
$cshow :: forall dur. Show dur => Rest dur -> String
showsPrec :: Int -> Rest dur -> ShowS
$cshowsPrec :: forall dur. Show dur => Int -> Rest dur -> ShowS
Show)

data NPitch pitch = CopyFrom | NPitch !pitch
    deriving (NPitch pitch -> NPitch pitch -> Bool
forall pitch. Eq pitch => NPitch pitch -> NPitch pitch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NPitch pitch -> NPitch pitch -> Bool
$c/= :: forall pitch. Eq pitch => NPitch pitch -> NPitch pitch -> Bool
== :: NPitch pitch -> NPitch pitch -> Bool
$c== :: forall pitch. Eq pitch => NPitch pitch -> NPitch pitch -> Bool
Eq, Int -> NPitch pitch -> ShowS
forall pitch. Show pitch => Int -> NPitch pitch -> ShowS
forall pitch. Show pitch => [NPitch pitch] -> ShowS
forall pitch. Show pitch => NPitch pitch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NPitch pitch] -> ShowS
$cshowList :: forall pitch. Show pitch => [NPitch pitch] -> ShowS
show :: NPitch pitch -> String
$cshow :: forall pitch. Show pitch => NPitch pitch -> String
showsPrec :: Int -> NPitch pitch -> ShowS
$cshowsPrec :: forall pitch. Show pitch => Int -> NPitch pitch -> ShowS
Show)

instance Pretty pitch => Pretty (NPitch pitch) where
    pretty :: NPitch pitch -> Text
pretty (NPitch pitch
pitch) = forall a. Pretty a => a -> Text
pretty pitch
pitch
    pretty NPitch pitch
CopyFrom = Text
"CopyFrom"

data Pitch = Pitch {
    Pitch -> Octave
pitch_octave :: !Octave
    , Pitch -> Text
pitch_call :: !Text
    } deriving (Pitch -> Pitch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pitch -> Pitch -> Bool
$c/= :: Pitch -> Pitch -> Bool
== :: Pitch -> Pitch -> Bool
$c== :: Pitch -> Pitch -> Bool
Eq, Int -> Pitch -> ShowS
[Pitch] -> ShowS
Pitch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pitch] -> ShowS
$cshowList :: [Pitch] -> ShowS
show :: Pitch -> String
$cshow :: Pitch -> String
showsPrec :: Int -> Pitch -> ShowS
$cshowsPrec :: Int -> Pitch -> ShowS
Show)

type PitchText = Text

data Octave = Absolute !Int | Relative !Int
    deriving (Octave -> Octave -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Octave -> Octave -> Bool
$c/= :: Octave -> Octave -> Bool
== :: Octave -> Octave -> Bool
$c== :: Octave -> Octave -> Bool
Eq, Int -> Octave -> ShowS
[Octave] -> ShowS
Octave -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Octave] -> ShowS
$cshowList :: [Octave] -> ShowS
show :: Octave -> String
$cshow :: Octave -> String
showsPrec :: Int -> Octave -> ShowS
$cshowsPrec :: Int -> Octave -> ShowS
Show)

data NDuration = NDuration !Duration | CallDuration
    deriving (NDuration -> NDuration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NDuration -> NDuration -> Bool
$c/= :: NDuration -> NDuration -> Bool
== :: NDuration -> NDuration -> Bool
$c== :: NDuration -> NDuration -> Bool
Eq, Int -> NDuration -> ShowS
[NDuration] -> ShowS
NDuration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NDuration] -> ShowS
$cshowList :: [NDuration] -> ShowS
show :: NDuration -> String
$cshow :: NDuration -> String
showsPrec :: Int -> NDuration -> ShowS
$cshowsPrec :: Int -> NDuration -> ShowS
Show)

data Duration = Duration {
    -- | Durations are specified as two optional integers: int1, or int1:int2.
    -- The interpretation is up to the dur Directive.
    Duration -> Maybe Int
dur_int1 :: !(Maybe Int)
    , Duration -> Maybe Int
dur_int2 :: !(Maybe Int)
    , Duration -> Int
dur_dots :: !Int
    , Duration -> Bool
dur_tie :: !Bool
    } deriving (Duration -> Duration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq, Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show)

-- * error

-- | Character position in the input.
newtype Pos = Pos Int deriving (Pos -> Pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, [Pos] -> Doc
Pos -> Text
Pos -> Doc
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [Pos] -> Doc
$cformatList :: [Pos] -> Doc
format :: Pos -> Doc
$cformat :: Pos -> Doc
pretty :: Pos -> Text
$cpretty :: Pos -> Text
Pretty)

data Error = Error !Pos !Text
    deriving (Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

instance Pretty Error where
    pretty :: Error -> Text
pretty (Error (Pos Int
pos) Text
msg) = forall a. Pretty a => a -> Text
pretty Int
pos forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
msg

show_error :: Text -> Error -> Text
show_error :: Text -> Error -> Text
show_error Text
source (Error Pos
pos Text
msg) = forall a. Textlike a => a -> a -> a
Texts.unlines2 Text
msg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ do
    (Int
line_num, Int
char_num, Text
line) <- Text -> Pos -> Maybe (Int, Int, Text)
find_pos Text
source Pos
pos
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines
        [ Int -> Char -> Text -> Text
Text.justifyRight Int
3 Char
' ' (forall a. Show a => a -> Text
showt Int
line_num) forall a. Semigroup a => a -> a -> a
<> Text
" | " forall a. Semigroup a => a -> a -> a
<> Text
line
        , Int -> Text -> Text
Text.replicate (Int
3 forall a. Num a => a -> a -> a
+ Int
3 forall a. Num a => a -> a -> a
+ Int
char_num) Text
" " forall a. Semigroup a => a -> a -> a
<> Text
"^"
        ]

-- | Find the line and position on that line.
find_pos :: Text -> Pos -> Maybe (Int, Int, Text)
find_pos :: Text -> Pos -> Maybe (Int, Int, Text)
find_pos Text
source (Pos Int
pos) =
    case forall key a. Ord key => (a -> key) -> key -> [a] -> [a]
Lists.dropBefore (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Int
pos (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Int, Text)]
lines) of
        (Int
line_num, (Int
start, Text
line)) : [(Int, (Int, Text))]
_ -> forall a. a -> Maybe a
Just (Int
line_num, Int
pos forall a. Num a => a -> a -> a
- Int
start, Text
line)
        [(Int, (Int, Text))]
_ -> forall a. Maybe a
Nothing
    where
    lines :: [(Int, Text)]
lines = forall accum key a.
(accum -> key -> accum)
-> (a -> key) -> accum -> [a] -> [(accum, a)]
Lists.scanlOn forall a. Num a => a -> a -> a
(+) ((forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length) Int
0 forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
source