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

module Derive.ParseSkeleton (
    Track(..)
    , default_parser, note_bottom_parser
) where
import qualified Data.Text as Text
import qualified Data.Tree as Tree

import qualified Util.Seq as Seq
import qualified Util.Trees as Trees
import qualified Derive.ParseTitle as ParseTitle
import qualified Ui.Skeleton as Skeleton

import           Global


-- TODO ParseTitle pulls in Derive.Parse when it only needs is_note_track and
-- is_tempo_track.  But everyone likely already needs Derive.Parse.

data Track = Track {
    Track -> Int
_tracknum :: !Int
    , Track -> Title
_title :: !Title
    } deriving (Int -> Track -> ShowS
[Track] -> ShowS
Track -> String
(Int -> Track -> ShowS)
-> (Track -> String) -> ([Track] -> ShowS) -> Show Track
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Track] -> ShowS
$cshowList :: [Track] -> ShowS
show :: Track -> String
$cshow :: Track -> String
showsPrec :: Int -> Track -> ShowS
$cshowsPrec :: Int -> Track -> ShowS
Show)
type Title = Text

-- | A parser figures out a skeleton based on track titles and position.
--
-- Tracks starting with '>' are instrument tracks, the rest are control tracks.
-- A track titled \"tempo\" scopes over all tracks to its right.
-- Below that, tracks scope left to right.
--
-- This should take arguments to apply to instrument and control tracks.
--
-- TODO do something special with embedded rulers and dividers
default_parser :: [Track] -> Skeleton.Skeleton
default_parser :: [Track] -> Skeleton
default_parser = Forest Track -> Skeleton
make_skeleton (Forest Track -> Skeleton)
-> ([Track] -> Forest Track) -> [Track] -> Skeleton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Track] -> Forest Track
parse_to_tree Bool
False

-- | The note-bottom parser puts note tracks at the bottom:
--
-- @[tempo c1 i1 c2 i2] -> [tempo1 (c1 i1) (c2 i2)]@
--
-- This is useful when you don't want to invoke slicing.
note_bottom_parser :: [Track] -> Skeleton.Skeleton
note_bottom_parser :: [Track] -> Skeleton
note_bottom_parser = Forest Track -> Skeleton
make_skeleton (Forest Track -> Skeleton)
-> ([Track] -> Forest Track) -> [Track] -> Skeleton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Track] -> Forest Track
parse_to_tree Bool
True

make_skeleton :: Tree.Forest Track -> Skeleton.Skeleton
make_skeleton :: Forest Track -> Skeleton
make_skeleton = [Edge] -> Skeleton
Skeleton.make ([Edge] -> Skeleton)
-> (Forest Track -> [Edge]) -> Forest Track -> Skeleton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree Int] -> [Edge]
forall a. [Tree a] -> [(a, a)]
Trees.edges ([Tree Int] -> [Edge])
-> (Forest Track -> [Tree Int]) -> Forest Track -> [Edge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree Track -> Tree Int) -> Forest Track -> [Tree Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Track -> Int) -> Tree Track -> Tree Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Track -> Int
_tracknum)

-- | [c0 tempo1 i1 c1 tempo2 c2 i2 c3] ->
-- c0 (tempo1 (i1 (c1)) (tempo2 (c2 (i2 (c3)))))
--
-- [i1, c1, i2] -> (i1 c1) (i2)
-- [i1, c1 -->, i2] -> i1 (c1 (i2))
parse_to_tree :: Bool -> [Track] -> Tree.Forest Track
parse_to_tree :: Bool -> [Track] -> Forest Track
parse_to_tree Bool
reversed [Track]
tracks = ([Track] -> Forest Track) -> [[Track]] -> Forest Track
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Track] -> Forest Track
parse [[Track]]
groups
    where
    groups :: [[Track]]
groups = (Title -> Bool) -> [Track] -> [[Track]]
split_title Title -> Bool
ParseTitle.is_tempo_track [Track]
tracks
    parse :: [Track] -> Forest Track
parse = if Bool
reversed then [Track] -> Forest Track
reverse_tempo_group else [Track] -> Forest Track
parse_tempo_group

parse_tempo_group :: [Track] -> Tree.Forest Track
parse_tempo_group :: [Track] -> Forest Track
parse_tempo_group = ([Track] -> Forest Track) -> [[Track]] -> Forest Track
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Track] -> Forest Track
parse_control_group ([[Track]] -> Forest Track)
-> ([Track] -> [[Track]]) -> [Track] -> Forest Track
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title -> Bool) -> [Track] -> [[Track]]
split_title Title -> Bool
is_cgroup
    where
    is_cgroup :: Title -> Bool
is_cgroup Title
t = Title -> Bool
ParseTitle.is_control_track Title
t Bool -> Bool -> Bool
&& Title
"-->" Title -> Title -> Bool
`Text.isSuffixOf` Title
t
    -- Use a --> "pragma" comment to make a control track associate to the
    -- right.

parse_control_group :: [Track] -> Tree.Forest Track
parse_control_group :: [Track] -> Forest Track
parse_control_group [Track]
tracks = case (Title -> Bool) -> [Track] -> [[Track]]
split_title Title -> Bool
ParseTitle.is_note_track [Track]
tracks of
    [] -> []
    [Track]
non_note : [[Track]]
ngroups -> [Track] -> Forest Track -> Forest Track
forall a. [a] -> Forest a -> Forest a
descend [Track]
non_note (([Track] -> Forest Track) -> [[Track]] -> Forest Track
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Track] -> Forest Track
forall a. [a] -> Forest a
parse_note_group [[Track]]
ngroups)

split_title :: (Title -> Bool) -> [Track] -> [[Track]]
split_title :: (Title -> Bool) -> [Track] -> [[Track]]
split_title Title -> Bool
f = (Track -> Bool) -> [Track] -> [[Track]]
forall a. (a -> Bool) -> [a] -> [[a]]
Seq.split_before (Title -> Bool
f (Title -> Bool) -> (Track -> Title) -> Track -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Title
_title)

reverse_tempo_group :: [Track] -> Tree.Forest Track
reverse_tempo_group :: [Track] -> Forest Track
reverse_tempo_group [] = []
reverse_tempo_group (Track
track:[Track]
tracks) =
    [Track -> Forest Track -> Tree Track
forall a. a -> [Tree a] -> Tree a
Tree.Node Track
track (Forest Track -> Tree Track) -> Forest Track -> Tree Track
forall a b. (a -> b) -> a -> b
$ ([Track] -> Forest Track) -> [[Track]] -> Forest Track
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Track] -> Forest Track
forall a. [a] -> Forest a
parse_note_group ([[Track]] -> [[Track]]
forall {a}. [[a]] -> [[a]]
shift [[Track]]
groups)]
    where
    groups :: [[Track]]
groups = (Title -> Bool) -> [Track] -> [[Track]]
split_title Title -> Bool
ParseTitle.is_note_track [Track]
tracks
    shift :: [[a]] -> [[a]]
shift ([a]
group : (a
note : [a]
rest) : [[a]]
gs) = ([a]
group [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
note]) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
shift ([a]
rest [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
gs)
    shift [[a]]
gs = [[a]]
gs

parse_note_group :: [a] -> Tree.Forest a
parse_note_group :: forall a. [a] -> Forest a
parse_note_group [a]
tracks = [a] -> Forest a -> Forest a
forall a. [a] -> Forest a -> Forest a
descend [a]
tracks []

descend :: [a] -> Tree.Forest a -> Tree.Forest a
descend :: forall a. [a] -> Forest a -> Forest a
descend [] Forest a
bottom = Forest a
bottom
descend (a
track:[a]
tracks) Forest a
bottom = [a -> Forest a -> Tree a
forall a. a -> [Tree a] -> Tree a
Tree.Node a
track ([a] -> Forest a -> Forest a
forall a. [a] -> Forest a -> Forest a
descend [a]
tracks Forest a
bottom)]