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