\begin{code} 
-- | 
-- Maintainer : silva.samuel@alumni.uminho.pt
-- Stability  : experimental
-- Portability: portable
-- This module implements Melodic Motive
module Music.Analysis.Abstract.Melodic where
import Music.Analysis.Base (Number, Text, Delta, 
    zipMaybe, unzipMaybe, toInteger, IntegerNumber)
import Music.Analysis.Abstract.Settings (Settings, 
    getNumber, fromList, number, text, changeText, priority)
import Music.Analysis.PF ((><), grd, swap, (-|-), p1, split,
    assocl, mapL, cataL, e2m, hyloL)
import Music.Analysis.Abstract.Motive (Motive, toMotive, fromMotive,
    mapMotive, cataMotive, meta)
import Data.Maybe (Maybe(..), maybe, fromJust, isNothing)
import Data.Either (either)
import Data.Function (id, const, (.))
import Data.Tuple (uncurry)
import Data.List ((++), (!!), init, tail, last)
import Data.Bool (otherwise, Bool(..), (&&))
import Data.Ord (Ord(..))
import Data.Eq (Eq(..))
import Data.Fixed (div', mod')
import Prelude (Num(..), mod, Show, Read)
\end{code} Accident is defined as number, however Natural isn't supported. Alternative to support Natural is defined using @Maybe Number@. Remember that Accident will be number of half-tones from base note. Settings are fundamental, in our model. Settings change some operations results. Mandatory settings are: \begin{description} \item[ClefName] by default is text "ClefG", \item[ClefNumber] by default is number 2, \item[Key] by default is number 0, \item[Mode] by default is text "Major", \item[Octave] by default is number 0. \end{description} Optional settings can be Type to expression motive type, such as, Relative, 7-Absolute, 12-Absolute or Alpha. Some operations expect specific Type, but doesn't test Type. \begin{code} 
-- | Melodic node 
type Pitch = Number
type MelodicNode = Maybe (Delta, Accident)
type MelodicRelative = Maybe (Delta, Accident)
type MelodicAbsolute = Maybe (Pitch, Accident)
type MelodicClass = Maybe (PitchClass, Accident)
-- | Accident is defined as number /provisional/. 
--  It doesn't support natural (only supports flats and sharps)
-- To supports sharps, flats and natural, it will be @Maybe Number@
-- This number is number of half-tones.
type Accident = Maybe Number
-- | 
data AccidentClass = DoubleSharp 
                   | Sharp 
                   | Natural 
                   | Flat 
                   | DoubleFlat
                   | UnknowAccident Text 
                   deriving (Eq, Show)
-- | Pitch Class definition
data PitchClass = C -- ^ C
                | D -- ^ D
                | E -- ^ E
                | F -- ^ F
                | G -- ^ G
                | A -- ^ A
                | B -- ^ B
                deriving (Eq, Show, Read)
-- | MelodicNode with PitchClass
type MelodicClassNode = Maybe (PitchClass, Accident)
-- | default settings
settings :: Settings
settings = fromList [
                ("ClefName",    text "ClefG" priority),
                ("ClefNumber",  number 2    priority),
                ("Key",         number 0    priority),
                ("Mode",        text "Major" priority),
                ("Octave",      number 0    priority)]
\end{code} Rest cab ne used as combinator, like maybe combinator. This combinator has same behaviour that maybe combinator. \begin{code} 
-- * Combinators
-- | rest combinator
rest :: b -> ( (Delta,Accident) -> b) -> MelodicNode -> b
rest = maybe
-- * Auxiliary functions
-- | Default rest
mkRest :: MelodicNode
mkRest = Nothing
-- | default non-rest
mkNoRest :: MelodicNode
mkNoRest = Just (0, Nothing)
\end{code} We presents simple functions that are reused at next stages. \begin{code} 
-- | Transforms 7-number into Char notation
pitch :: (Number, Accident) -> (IntegerNumber, (PitchClass, Accident))
pitch (x,y) = 
    (div' (toInteger x) 7, ([C,D,E,F,G,A,B]!!mod' (toInteger x) 7, pitch_alter y))
    where pitch_alter :: Accident -> Accident
          pitch_alter = id 
-- | Transforms 7-number into Char notation
pitch' :: (Number, Accident) -> (PitchClass, Accident)
pitch' (x,y) = ([C,D,E,F,G,A,B]!!mod (toInteger x) 7, pitch_alter' y)
    where pitch_alter' :: Accident -> Accident
          pitch_alter' = id 
-- | Transforms Char into 7-Number  notation
absPitch :: (PitchClass, Accident) -> (Number, Accident)
absPitch = absPitch_class >< absPitch_alter
    where absPitch_class :: PitchClass -> Number
          absPitch_class pc = case pc of 
            C -> 0; D -> 1; E -> 2; F -> 3; G -> 4; A -> 5; B -> 6;
          absPitch_alter :: Accident -> Accident
          absPitch_alter = id
-- | Transpose to 12 level 
transpose12 :: Number -> MelodicAbsolute -> MelodicAbsolute
transpose12 n = rest Nothing (Just . ((n+) >< id) )
-- | transforms 7 level to 12-level notation
f7to12 :: (Number, Accident) -> (Number, Accident)
f7to12 (n, ac) | n < 0 = let (x,y) = f7to12 (n+7,ac) in (x - 12, y)
               | n > 6 = let (x,y) = f7to12 (n-7,ac) in (x + 12, y)
               | otherwise = case n of
                    _ -> ([0,2,4,5,7,9,11]!!(toInteger n),ac)
-- | transforms 12-level into 7-level notation
f12to7 :: (Number, Accident) -> (Number, Accident)
f12to7 (n, Nothing) = f12to7 (n, Just 0)
f12to7 (n,ac@(Just a)) | n < 0 = let (x,y) = f12to7 (n+12, ac) in (x - 7, y)
                       | n > 11 = let (x,y) = f12to7 (n-12, ac) in (x + 7, y)
                       | otherwise = case n of
                    0 -> (0, ac); 2 -> (1, ac); 4 -> (2, ac); 
                    5 -> (3, ac); 7 -> (4, ac); 9 -> (5, ac); 11 -> (6, ac);
                    _ -> 
                         if a > 0
                         then let (x,y) = f12to7 (n-1, ac) in 
                            case y of 
                                (Just y') -> (x, Just (y'+1))
                                Nothing   -> (x, Just 1)
                         else let (x,y) = f12to7 (n+1, ac) in 
                            case y of 
                                (Just y') -> (x, Just (y'-1))
                                Nothing   -> (x, Just (-1))
\end{code} This stage presents some combinators, like transpose. \begin{code} 
-- | Transposes over 7 absolute level
transpose :: Number -> Motive MelodicAbsolute -> Motive MelodicAbsolute
transpose n = 
  mapMotive (const (either id (Just . f12to7 . ((n+) >< id) . f7to12 . fromJust) . grd isNothing))
-- | Reverse
reverse :: Motive MelodicNode -> Motive MelodicNode
reverse = 
    toMotive . cataMotive [] (const (uncurry (++) . swap . ((:[]) >< id)))
-- | symmetric melodic
symmetric :: Number -> Motive MelodicAbsolute -> Motive MelodicAbsolute
symmetric n = 
    mapMotive (const (rest Nothing (Just . ((n +) . ((-)n) >< id ))))
\end{code} We expect that Type of input Motive Melodic to \begin{description} \item[toAlpha] is 7-Absolute and result will be Alpha, \item[fromAlpha] is Alpha and result will be 7-Absolute, \item[to12] is 7-Absolute and result will be 12-Absolute, \item[from12] is 12-Absolute and result will be 7-Absolute, \end{description} Function toAlpha' is deprecated, because isn't so expressive as toAlpha. \begin{code} 
-- | Convert to alpha notation
toAlpha :: Motive MelodicAbsolute -> 
    Motive (Maybe (IntegerNumber, (PitchClass, Accident)))
toAlpha = meta (changeText "Type" "Alpha") .
    mapMotive (const (maybe Nothing (Just . pitch)))
-- | Convert to alpha notation
toAlpha' :: Motive MelodicNode -> Motive MelodicClassNode
toAlpha' = meta (changeText "Type" "Alpha") .
    mapMotive (const (rest Nothing (Just . pitch')))
-- | get 7-Absolute music from alpha notation
fromAlpha :: Motive MelodicClassNode -> Motive MelodicAbsolute
fromAlpha = meta (changeText "Type" "7-Absolute") .
    mapMotive (const (maybe Nothing (Just . absPitch)))
-- | Convert 7-absolute into 12-absolute notation
to12 :: Motive MelodicAbsolute -> Motive MelodicAbsolute
to12 = meta (changeText "Type" "12-Absolute") .
    mapMotive (const (rest Nothing (Just . f7to12)))
-- | Convert 12-absolute into 7-absolute notation
from12 :: Motive MelodicAbsolute -> Motive MelodicAbsolute
from12 = meta (changeText "Type" "7-Absolute") . 
    mapMotive (const (rest Nothing (Just . f12to7)))
\end{code} relative function isn't PF-approach, but works. Absolute functionat that computes absolute motive from relative is written using Point-Free approach. To get Absolute is built list of all initials Melodics and sum it. \begin{code} 
-- | relative melodic.
relative :: Motive MelodicAbsolute -> Motive MelodicRelative
relative = 
    toMotive . 
    split (changeText "Type" "Relative" . p1) 
          (\(m1,m2) -> aux1 (maybe 0 id (getNumber "Key" m1)) m2) . 
    fromMotive
    where aux1 :: Number -> [MelodicNode] -> [MelodicNode]
          aux1 _ [] = []
          aux1 acc (x:l) = 
                maybe Nothing (Just . ((\a -> a - acc) >< id)) x :
                aux1 (maybe acc p1 x) l
-- | absolute PF
absolute :: Motive MelodicRelative -> Motive MelodicAbsolute
absolute = toMotive .
    split (changeText "Type" "7-Absolute" . p1) 
        (zipMaybe . 
         (tail . 
          mapL (either last (Just . sumRelatives ) . grd guard) . 
          hyloL reverses getInits . -- get inits and reverse reversed result
          uncurry (:)               -- append key
          >< id) .                  -- doesn't change alter
        (assocl . (id >< unzipMaybe)) .
        (maybe (Just 0) Just . getNumber "Key" >< id)) -- get key
    . fromMotive
    where 
        -- | condition
        guard :: [Maybe Delta] -> Bool
        guard l = l /= [] && last l == Nothing
        -- | sum with Maybe
        sumRelatives :: [Maybe Delta] -> Number
        sumRelatives = cataL (maybe 0 (uncurry (+) . (maybe 0 id >< id)))
        -- | get inits
        getInits :: [Maybe Number] -> Maybe ([Maybe Number], [Maybe Number])
        getInits = e2m . ( const () -|- split id init) . grd (==[])
        -- | reverse
        reverses :: Maybe ([Maybe Number],[[Maybe Number]]) -> [[Maybe Number]]
        reverses = maybe [] (uncurry (++) . swap . ((:[]) >< id))
\end{code}