module Mezzo.Model.Errors where
import Mezzo.Model.Types
import GHC.TypeLits
type PitchPair = (PitchType, PitchType)
data DyadPair = DyP PitchPair PitchPair
type family DyPair p1 p2 q1 q2 :: DyadPair where
DyPair p1 p2 q1 q2 = DyP '(p1, p2) '(q1, q2)
type family PpPC (pc :: PitchClass) :: ErrorMessage where
PpPC C = Text "C"
PpPC D = Text "D"
PpPC E = Text "E"
PpPC F = Text "F"
PpPC G = Text "G"
PpPC A = Text "A"
PpPC B = Text "B"
type family PpAcc (acc :: Accidental) :: ErrorMessage where
PpAcc Natural = Text ""
PpAcc Sharp = Text "#"
PpAcc Flat = Text "b"
type family PpOct (oct :: OctaveNum) :: ErrorMessage where
PpOct Oct_1 = Text "_5"
PpOct Oct0 = Text "_4"
PpOct Oct1 = Text "_3"
PpOct Oct2 = Text "__"
PpOct Oct3 = Text "_"
PpOct Oct4 = Text ""
PpOct Oct5 = Text "'"
PpOct Oct6 = Text "''"
PpOct Oct7 = Text "'3"
PpOct Oct8 = Text "'4"
type family PpPitch (p :: PitchType) :: ErrorMessage where
PpPitch (Pitch pc acc oct) = PpPC pc :<>: PpAcc acc :<>: PpOct oct
PpPitch Silence = Text "Rest"
type family PpPitchPair (pp :: PitchPair) :: ErrorMessage where
PpPitchPair '(p1, p2) = PpPitch p1 :<>: Text " and " :<>: PpPitch p2
type family PpDyadPair (dp :: DyadPair) :: ErrorMessage where
PpDyadPair (DyP d1 d2) = PpPitchPair d1 :<>: Text ", then " :<>: PpPitchPair d2
type family PitchError (t :: Symbol) (p :: PitchType) where
PitchError t p = TypeError (Text t :<>: PpPitch p)
type family PitchPairError (t :: Symbol) (p :: PitchPair) where
PitchPairError t p = TypeError (Text t :<>: PpPitchPair p)
type family MotionError (t :: Symbol) (d :: DyadPair) where
MotionError t p = TypeError (Text t :<>: PpDyadPair p)
type family ChordError (t1 :: Symbol) (r :: RootType) (t2 :: Symbol) where
ChordError t1 r t2 = TypeError (Text t1 :<>: PpPitch (RootToPitch r) :<>: Text t2)