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

{-# LANGUAGE CPP #-}
-- | Format korvais as HTML.
module Solkattu.Format.Html (
    indexHtml, writeAll
#ifdef TESTING
    , module Solkattu.Format.Html
#endif
) where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Time.Calendar as Calendar

import qualified Util.File as File
import qualified Util.Html as Html
import qualified Util.Seq as Seq
import qualified Util.Styled as Styled
import qualified Util.Texts as Texts

import qualified Solkattu.Format.Format as Format
import qualified Solkattu.Korvai as Korvai
import qualified Solkattu.Metadata as Metadata
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu
import qualified Solkattu.Tags as Tags
import qualified Solkattu.Tala as Tala

import           Global


-- * interface

-- | Make a summary page with all the korvais.
indexHtml :: (Korvai.Score -> FilePath) -> [Korvai.Score] -> Html.Html
indexHtml :: (Score -> FilePath) -> [Score] -> Html
indexHtml Score -> FilePath
scoreFname [Score]
scores = Html -> [Html] -> Html
forall a. Textlike a => a -> [a] -> a
Texts.join Html
"\n" ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
    [ Html
"<html> <head>"
    , Html
"<meta charset=utf-8>"
    , Html
"<title>solkattu db</title>"
    , Html
"<style>"
    , Html
"table {"
    , Html
"    border-collapse: collapse;"
    , Html
"}"
    , Html
"tr:nth-child(even) {"
    , Html
"    background-color: #f2f2f2;"
    , Html
"}"
    , Html
"th, td {"
    , Html
"    padding: 4px;"
    , Html
"    border-left: 1px solid black;"
    , Html
"}"
    , Html
"</style>"
    , Html
"</head> <body>"
    , Html
"<table id=korvais>"
    , Html
"<tr>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html
"<th>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
c Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</th>" | (Html
c, Score -> Html
_) <- [(Html, Score -> Html)]
columns] Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</tr>"
    ] [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ (Score -> Html) -> [Score] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map Score -> Html
row ((Score -> Maybe Day) -> [Score] -> [Score]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Seq.sort_on Score -> Maybe Day
scoreDate [Score]
scores) [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++
    [ Html
"</table>"
    , Html
"<script>"
    , Html
javascriptIndex
    , Html
"</script>"
    , Html
"</body></html>"
    ]
    where
    row :: Score -> Html
row Score
score = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat
        [ Html
"<tr>"
        , [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html
"<td>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Score -> Html
cellOf Score
score Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</td>" | (Html
_, Score -> Html
cellOf) <- [(Html, Score -> Html)]
columns]
        , Html
"</tr>"
        ]
    columns :: [(Html, Score -> Html)]
columns =
        [ (Html
"name", Score -> Html
nameOf)
        , (Html
"type", Text -> Html
Html.html (Text -> Html) -> (Score -> Text) -> Score -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unwords ([Text] -> Text) -> (Score -> [Text]) -> Score -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"type")
        , (Html
"tala", [Text] -> Html
commas ([Text] -> Html) -> (Score -> [Text]) -> Score -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> [Text]
scoreTalas)
        , (Html
"nadai", [Text] -> Html
commas ([Text] -> Html) -> (Score -> [Text]) -> Score -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.sectionTag Text
"nadai")
        , (Html
"avart", [Text] -> Html
commas ([Text] -> Html) -> (Score -> [Text]) -> Score -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"avartanams")
        , (Html
"date", Text -> Html
Html.html (Text -> Html) -> (Score -> Text) -> Score -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Day -> Text) -> Maybe Day -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Day -> Text
showDate (Maybe Day -> Text) -> (Score -> Maybe Day) -> Score -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> Maybe Day
scoreDate)
        , (Html
"instruments", [Text] -> Html
commas ([Text] -> Html) -> (Score -> [Text]) -> Score -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"instrument")
        , (Html
"source", [Text] -> Html
commas ([Text] -> Html) -> (Score -> [Text]) -> Score -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"source")
        ]
    nameOf :: Score -> Html
nameOf Score
score = Text -> Text -> Html
Html.link Text
varName (FilePath -> Text
txt (Score -> FilePath
scoreFname Score
score))
        where (Text
_, Int
_, Text
varName) = Metadata -> (Text, Int, Text)
Korvai._location (Metadata -> (Text, Int, Text)) -> Metadata -> (Text, Int, Text)
forall a b. (a -> b) -> a -> b
$ Score -> Metadata
Korvai.scoreMetadata Score
score
    commas :: [Text] -> Html
commas = Text -> Html
Html.html (Text -> Html) -> ([Text] -> Text) -> [Text] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
", "

scoreDate :: Korvai.Score -> Maybe Calendar.Day
scoreDate :: Score -> Maybe Day
scoreDate = \case
    Korvai.Single Korvai
k -> Korvai -> Maybe Day
date Korvai
k
    Korvai.Tani Metadata
meta [Part Korvai]
parts -> case Metadata -> Maybe Day
Korvai._date Metadata
meta of
        Just Day
day -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
day
        Maybe Day
Nothing -> [Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
Seq.maximum ([Day] -> Maybe Day) -> [Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ (Korvai -> Maybe Day) -> [Korvai] -> [Day]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Korvai -> Maybe Day
date [Korvai
k | Korvai.K Korvai
k <- [Part Korvai]
parts]
    where date :: Korvai -> Maybe Day
date = Metadata -> Maybe Day
Korvai._date (Metadata -> Maybe Day)
-> (Korvai -> Metadata) -> Korvai -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Korvai -> Metadata
Korvai.korvaiMetadata

javascriptIndex :: Html.Html
javascriptIndex :: Html
javascriptIndex =
    Html
"const table = document.getElementById('korvais');\n\
    \const headers = table.querySelectorAll('th');\n\
    \const headerTexts = Array.from(headers).map(\n\
    \    function (h) { return h.innerText; });\n\
    \const up = '↑';\n\
    \const down ='↓';\n\
    \const both = '↕︎';\n\
    \[].forEach.call(headers, function(header, index) {\n\
    \    header.addEventListener('click', function() {\n\
    \        sortColumn(index);\n\
    \    });\n\
    \});\n\
    \const tableBody = table.querySelector('tbody');\n\
    \const rows = tableBody.querySelectorAll('tr');\n\
    \const directions = Array.from(headers).map(\n\
    \    function(header) { return 1; });\n\
    \\n\
    \const sortColumn = function(index) {\n\
    \    [].forEach.call(headers, function(header, i) {\n\
    \        var arrow = both;\n\
    \        if (i == index) {\n\
    \            arrow = directions[index] == 1 ? down : up;\n\
    \        } else {\n\
    \            directions[i] = 1;\n\
    \        }\n\
    \        header.innerText = headerTexts[i] + ' ' + arrow;\n\
    \    });\n\
    \    const newRows = Array.from(rows).slice(1);\n\
    \    newRows.sort(function(rowA, rowB) {\n\
    \        a = rowA.querySelectorAll('td')[index].innerText;\n\
    \        b = rowB.querySelectorAll('td')[index].innerText;\n\
    \        if (isInt(a) && isInt(b)) {\n\
    \            a = parseInt(a);\n\
    \            b = parseInt(b);\n\
    \        }\n\
    \        if (a > b)\n\
    \            return 1 * directions[index];\n\
    \        else if (a < b)\n\
    \            return -1 * directions[index];\n\
    \        else\n\
    \            return 0;\n\
    \    });\n\
    \    directions[index] = -directions[index];\n\
    \    [].forEach.call(rows, function(row) {\n\
    \        tableBody.removeChild(row);\n\
    \    });\n\
    \    tableBody.appendChild(rows[0]);\n\
    \    newRows.forEach(function(newRow) {\n\
    \        tableBody.appendChild(newRow);\n\
    \    });\n\
    \};\n\
    \const isInt = function(x) { return x.match('^[0-9]+$') != null; };\n\
    \sortColumn(headerTexts.indexOf('date'));\n"

-- | Write HTML with all the instrument realizations at all abstraction levels.
writeAll :: FilePath -> Korvai.Score -> IO ()
writeAll :: FilePath -> Score -> IO ()
writeAll FilePath
fname Score
score = FilePath -> [Text] -> IO ()
File.writeLines FilePath
fname ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Html -> Text) -> [Html] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Html -> Text
Html.un_html ([Html] -> [Text]) -> [Html] -> [Text]
forall a b. (a -> b) -> a -> b
$
    [(Text, Abstraction)] -> Score -> [Html]
render [(Text, Abstraction)]
defaultAbstractions Score
score


-- * high level

data Config = Config {
    Config -> Abstraction
_abstraction :: !Format.Abstraction
    , Config -> Font
_font :: !Font
    -- | Show the ruler on multiples of this line as a reminder.  The ruler is
    -- always shown if it changes.  It should be a multiple of 2 to avoid
    -- getting the second half of a talam in case it's split in half.
    , Config -> Int
_rulerEach :: !Int
    } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> FilePath
(Int -> Config -> ShowS)
-> (Config -> FilePath) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> FilePath
$cshow :: Config -> FilePath
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

-- | HTML output has vertical lines for ruler marks, so they can be rarer.
defaultRulerEach :: Int
defaultRulerEach :: Int
defaultRulerEach = Int
8

data Font = Font { Font -> Int
_sizePercent :: Int, Font -> Bool
_monospace :: Bool }
    deriving (Int -> Font -> ShowS
[Font] -> ShowS
Font -> FilePath
(Int -> Font -> ShowS)
-> (Font -> FilePath) -> ([Font] -> ShowS) -> Show Font
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Font] -> ShowS
$cshowList :: [Font] -> ShowS
show :: Font -> FilePath
$cshow :: Font -> FilePath
showsPrec :: Int -> Font -> ShowS
$cshowsPrec :: Int -> Font -> ShowS
Show)

defaultAbstractions :: [(Text, Format.Abstraction)]
defaultAbstractions :: [(Text, Abstraction)]
defaultAbstractions =
    [ (Text
"none", Abstraction
forall a. Monoid a => a
mempty)
    , (Text
"sarva", GroupType -> Abstraction
Format.abstract GroupType
Solkattu.GSarva)
    , (Text
"patterns", Abstraction
Format.defaultAbstraction)
    , (Text
"all", Abstraction
Format.allAbstract)
    ]

defaultAbstraction :: Text
defaultAbstraction :: Text
defaultAbstraction = Text
"patterns"

-- | Render all 'Abstraction's, with javascript to switch between them.
render :: [(Text, Format.Abstraction)] -> Korvai.Score -> [Html.Html]
render :: [(Text, Abstraction)] -> Score -> [Html]
render [(Text, Abstraction)]
abstractions Score
score = Text -> [Html] -> [Html] -> [Html]
htmlPage Text
title (Score -> [Html]
scoreMetadata Score
score) [Html]
body
    where
    (Text
_, Int
_, Text
title) = Metadata -> (Text, Int, Text)
Korvai._location (Score -> Metadata
Korvai.scoreMetadata Score
score)
    body :: [Html.Html]
    body :: [Html]
body = (GInstrument -> [Html]) -> [GInstrument] -> [Html]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GInstrument -> [Html]
htmlInstrument ([GInstrument] -> [Html]) -> [GInstrument] -> [Html]
forall a b. (a -> b) -> a -> b
$ Score -> [GInstrument]
Format.scoreInstruments Score
score
    htmlInstrument :: GInstrument -> [Html]
htmlInstrument (Korvai.GInstrument Instrument stroke
inst) =
        Html
"<h3>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
instName Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</h3>"
        Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [(Text, Abstraction)] -> Text -> Html
chooseAbstraction [(Text, Abstraction)]
abstractions Text
instName
        Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: ((Text, Abstraction) -> [Html]) -> [(Text, Abstraction)] -> [Html]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Instrument stroke -> Score -> (Text, Abstraction) -> [Html]
forall stroke.
(Notation stroke, Ord stroke) =>
Text -> Instrument stroke -> Score -> (Text, Abstraction) -> [Html]
renderAbstraction Text
instName Instrument stroke
inst Score
score) [(Text, Abstraction)]
abstractions
        where
        instName :: Text
instName = Instrument stroke -> Text
forall stroke. Instrument stroke -> Text
Korvai.instrumentName Instrument stroke
inst

htmlPage :: Text -> [Html.Html] -> [Html.Html] -> [Html.Html]
htmlPage :: Text -> [Html] -> [Html] -> [Html]
htmlPage Text
title [Html]
meta [Html]
body = Text -> Html
htmlHeader Text
title Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [Html]
meta [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
body [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html
htmlFooter]

renderAbstraction :: (Solkattu.Notation stroke, Ord stroke)
    => Text -> Korvai.Instrument stroke -> Korvai.Score
    -> (Text, Format.Abstraction) -> [Html.Html]
renderAbstraction :: forall stroke.
(Notation stroke, Ord stroke) =>
Text -> Instrument stroke -> Score -> (Text, Abstraction) -> [Html]
renderAbstraction Text
instName Instrument stroke
inst Score
score (Text
aname, Abstraction
abstraction) =
    Text -> [(Text, Text)] -> Maybe Html -> Html
Html.tag_attrs Text
"div" [(Text, Text)]
attrs Maybe Html
forall a. Maybe a
Nothing
    Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: (case Score
score of
        Korvai.Single Korvai
korvai -> Korvai -> [Html]
render Korvai
korvai
        Korvai.Tani Metadata
_ [Part Korvai]
parts -> (Part Korvai -> [Html]) -> [Part Korvai] -> [Html]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Part Korvai -> [Html]
partHtmls [Part Korvai]
parts)
    [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html
"</div>"]
    where
    partHtmls :: Part Korvai -> [Html]
partHtmls (Korvai.Comment Text
cmt) = [Html
"<h3>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
cmt Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</h3>"]
    partHtmls (Korvai.K Korvai
korvai) = Korvai -> [Html]
render Korvai
korvai
    render :: Korvai -> [Html]
render = Instrument stroke -> Config -> Korvai -> [Html]
forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Config -> Korvai -> [Html]
sectionHtmls Instrument stroke
inst (Abstraction -> Config
config Abstraction
abstraction)
    attrs :: [(Text, Text)]
attrs =
        [ (Text
"class", Text
"realization")
        , (Text
"instrument", Text
instName)
        , (Text
"abstraction", Text
aname)
        ] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ if Text
aname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
defaultAbstraction
        then [(Text
"", Text
"")] else [(Text
"hidden", Text
"")]
    config :: Abstraction -> Config
config Abstraction
abstraction = Config
        { _abstraction :: Abstraction
_abstraction = Abstraction
abstraction
        , _font :: Font
_font = if Text
instName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"konnakol"
            then Font
konnakolFont else Font
instrumentFont
        , _rulerEach :: Int
_rulerEach = Int
defaultRulerEach
        }

sectionHtmls :: (Solkattu.Notation stroke, Ord stroke)
    => Korvai.Instrument stroke -> Config -> Korvai.Korvai -> [Html.Html]
sectionHtmls :: forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Config -> Korvai -> [Html]
sectionHtmls Instrument stroke
inst Config
config Korvai
korvai =
    -- Group rows by fst, which is whether it has a ruler, and put <table>
    -- around each group.  This is because each ruler may have a different
    -- nadai and hence a different number of columns.
    ([(Bool, [Html])] -> [Html]) -> [[(Bool, [Html])]] -> [Html]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Font -> [Html] -> [Html]
scoreTable (Config -> Font
_font Config
config) ([Html] -> [Html])
-> ([(Bool, [Html])] -> [Html]) -> [(Bool, [Html])] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Html]] -> [Html]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Html]] -> [Html])
-> ([(Bool, [Html])] -> [[Html]]) -> [(Bool, [Html])] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, [Html]) -> [Html]) -> [(Bool, [Html])] -> [[Html]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, [Html]) -> [Html]
forall a b. (a, b) -> b
snd) ([[(Bool, [Html])]] -> [Html]) -> [[(Bool, [Html])]] -> [Html]
forall a b. (a -> b) -> a -> b
$
    ((Bool, [Html]) -> Bool) -> [(Bool, [Html])] -> [[(Bool, [Html])]]
forall a. (a -> Bool) -> [a] -> [[a]]
Seq.split_before (Bool, [Html]) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, [Html])] -> [[(Bool, [Html])]])
-> [(Bool, [Html])] -> [[(Bool, [Html])]]
forall a b. (a -> b) -> a -> b
$
    [[(Bool, [Html])]] -> [(Bool, [Html])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Bool, [Html])]] -> [(Bool, [Html])])
-> [[(Bool, [Html])]] -> [(Bool, [Html])]
forall a b. (a -> b) -> a -> b
$ (PrevRuler, [[(Bool, [Html])]]) -> [[(Bool, [Html])]]
forall a b. (a, b) -> b
snd ((PrevRuler, [[(Bool, [Html])]]) -> [[(Bool, [Html])]])
-> (PrevRuler, [[(Bool, [Html])]]) -> [[(Bool, [Html])]]
forall a b. (a -> b) -> a -> b
$ (PrevRuler
 -> (Int, Section (),
     Either Text ([Flat Meta (Note stroke)], [Warning]))
 -> (PrevRuler, [(Bool, [Html])]))
-> PrevRuler
-> [(Int, Section (),
     Either Text ([Flat Meta (Note stroke)], [Warning]))]
-> (PrevRuler, [[(Bool, [Html])]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL PrevRuler
-> (Int, Section (),
    Either Text ([Flat Meta (Note stroke)], [Warning]))
-> (PrevRuler, [(Bool, [Html])])
forall {stroke}.
Notation stroke =>
PrevRuler
-> (Int, Section (),
    Either Text ([Flat Meta (Note stroke)], [Warning]))
-> (PrevRuler, [(Bool, [Html])])
show1 (Maybe Ruler
forall a. Maybe a
Nothing, Int
0) ([(Int, Section (),
   Either Text ([Flat Meta (Note stroke)], [Warning]))]
 -> (PrevRuler, [[(Bool, [Html])]]))
-> [(Int, Section (),
     Either Text ([Flat Meta (Note stroke)], [Warning]))]
-> (PrevRuler, [[(Bool, [Html])]])
forall a b. (a -> b) -> a -> b
$
    [Int]
-> [Section ()]
-> [Either Text ([Flat Meta (Note stroke)], [Warning])]
-> [(Int, Section (),
     Either Text ([Flat Meta (Note stroke)], [Warning]))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] (Korvai -> [Section ()]
Korvai.genericSections Korvai
korvai) [Either Text ([Flat Meta (Note stroke)], [Warning])]
sectionNotes
    where
    sectionNotes :: [Either Text ([Flat Meta (Note stroke)], [Warning])]
sectionNotes = [Either Text ([Flat stroke], [Warning])]
-> [Either Text ([Flat Meta (Note stroke)], [Warning])]
forall stroke warnings.
[Either Text ([Flat stroke], warnings)]
-> [Either Text ([Flat stroke], warnings)]
Format.convertGroups (Instrument stroke
-> Korvai -> [Either Text ([Flat stroke], [Warning])]
forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Korvai -> [Either Text (Realized stroke)]
Korvai.realize Instrument stroke
inst Korvai
korvai)
    show1 :: PrevRuler
-> (Int, Section (),
    Either Text ([Flat Meta (Note stroke)], [Warning]))
-> (PrevRuler, [(Bool, [Html])])
show1 PrevRuler
prevRuler (Int
i, Section ()
section, Either Text ([Flat Meta (Note stroke)], [Warning])
notes) = case Either Text ([Flat Meta (Note stroke)], [Warning])
notes of
        Left Text
err -> (PrevRuler
prevRuler, [Text -> (Bool, [Html])
msgRow (Text -> (Bool, [Html])) -> Text -> (Bool, [Html])
forall a b. (a -> b) -> a -> b
$ Text
"ERROR: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err])
        Right ([Flat Meta (Note stroke)]
notes, [Warning]
warnings) -> (PrevRuler
nextRuler,) ([(Bool, [Html])] -> (PrevRuler, [(Bool, [Html])]))
-> [(Bool, [Html])] -> (PrevRuler, [(Bool, [Html])])
forall a b. (a -> b) -> a -> b
$
            Tala
-> Int
-> Section ()
-> [(Maybe Ruler, [(State, Symbol)])]
-> [(Bool, [Html])]
formatTable Tala
tala Int
i Section ()
section [(Maybe Ruler, [(State, Symbol)])]
avartanams
            [(Bool, [Html])] -> [(Bool, [Html])] -> [(Bool, [Html])]
forall a. [a] -> [a] -> [a]
++ (Warning -> (Bool, [Html])) -> [Warning] -> [(Bool, [Html])]
forall a b. (a -> b) -> [a] -> [b]
map Warning -> (Bool, [Html])
showWarning [Warning]
warnings
            where
            (PrevRuler
nextRuler, [(Maybe Ruler, [(State, Symbol)])]
avartanams) =
                Config
-> Int
-> PrevRuler
-> Tala
-> [Flat Meta (Note stroke)]
-> (PrevRuler, [(Maybe Ruler, [(State, Symbol)])])
forall stroke.
Notation stroke =>
Config
-> Int
-> PrevRuler
-> Tala
-> [Flat Meta (Note stroke)]
-> (PrevRuler, [(Maybe Ruler, [(State, Symbol)])])
formatAvartanams Config
config Int
toSpeed PrevRuler
prevRuler Tala
tala [Flat Meta (Note stroke)]
notes
            tala :: Tala
tala = Korvai -> Tala
Korvai.korvaiTala Korvai
korvai
    showWarning :: Warning -> (Bool, [Html])
showWarning (Realize.Warning Maybe Int
_i Text
msg) = Text -> (Bool, [Html])
msgRow (Text -> (Bool, [Html])) -> Text -> (Bool, [Html])
forall a b. (a -> b) -> a -> b
$ Text
"WARNING: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    toSpeed :: Int
toSpeed = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Flat Meta (Note stroke)] -> Int)
-> [[Flat Meta (Note stroke)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Flat Meta (Note stroke)] -> Int
forall g a. [Flat g a] -> Int
S.maxSpeed ((Either Text ([Flat Meta (Note stroke)], [Warning])
 -> Maybe [Flat Meta (Note stroke)])
-> [Either Text ([Flat Meta (Note stroke)], [Warning])]
-> [[Flat Meta (Note stroke)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either Text ([Flat Meta (Note stroke)], [Warning])
-> Maybe [Flat Meta (Note stroke)]
forall {a} {a} {b}. Either a (a, b) -> Maybe a
notesOf [Either Text ([Flat Meta (Note stroke)], [Warning])]
sectionNotes)
    notesOf :: Either a (a, b) -> Maybe a
notesOf (Right (a
notes, b
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
notes
    notesOf Either a (a, b)
_ = Maybe a
forall a. Maybe a
Nothing

msgRow :: Text -> (Bool, [Html.Html])
msgRow :: Text -> (Bool, [Html])
msgRow Text
msg =
    (Bool
False, [Html
"<tr><td colspan=100>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
msg Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</td></tr>"])

scoreTable :: Font -> [Html.Html] -> [Html.Html]
scoreTable :: Font -> [Html] -> [Html]
scoreTable Font
_ [] = [] -- Seq.split_before produces []s
scoreTable Font
font [Html]
rows = [[Html]] -> [Html]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Html
"\n<p><table style=\"" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
fontStyle
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"\" class=konnakol cellpadding=0 cellspacing=0>"]
    , [Html]
rows
    , [Html
"</table>"]
    ]
    where
    fontStyle :: Html
fontStyle = Html
"font-size: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html (Int -> Text
forall a. Show a => a -> Text
showt (Font -> Int
_sizePercent Font
font)) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"%"
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> if Font -> Bool
_monospace Font
font then Html
"; font-family: Monaco, monospace" else Html
""

htmlHeader :: Text -> Html.Html
htmlHeader :: Text -> Html
htmlHeader Text
title = Html -> [Html] -> Html
forall a. Textlike a => a -> [a] -> a
Texts.join Html
"\n"
    [ Html
"<html><head>"
    , Html
"<meta charset=utf-8>"
    , Html
"<title>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
title Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</title></head>"
    , Html
"<body>"
    , Html
""
    , Html
"<style type=\"text/css\">"
    , Html
allCss
    , Html
"</style>"
    , Html
""
    , Html
"<script>"
    , Html
javascript
    , Html
"</script>"
    , Html
""
    ]

javascript :: Html.Html
javascript :: Html
javascript =
    Html
"function showAbstraction(instrument, abstraction) {\n\
    \    var tables = document.getElementsByClassName('realization');\n\
    \    for (var i = 0; i < tables.length; i++) {\n\
    \        var attrs = tables[i].attributes;\n\
    \        if (attrs.instrument.value == instrument) {\n\
    \            tables[i].hidden = attrs.abstraction.value != abstraction;\n\
    \        }\n\
    \    }\n\
    \}\n"

chooseAbstraction :: [(Text, Format.Abstraction)] -> Text -> Html.Html
chooseAbstraction :: [(Text, Abstraction)] -> Text -> Html
chooseAbstraction [(Text, Abstraction)]
abstractions Text
instrument =
    Html
"\n<p> " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> ((Text, Abstraction) -> Html) -> [(Text, Abstraction)] -> Html
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap ((Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>Html
"\n") (Html -> Html)
-> ((Text, Abstraction) -> Html) -> (Text, Abstraction) -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
radio (Text -> Html)
-> ((Text, Abstraction) -> Text) -> (Text, Abstraction) -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Abstraction) -> Text
forall a b. (a, b) -> a
fst) [(Text, Abstraction)]
abstractions
    where
    -- <label> makes the text clickable too.
    radio :: Text -> Html
radio Text
val = Text -> Html -> Html
Html.tag Text
"label" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        Text -> [(Text, Text)] -> Maybe Html -> Html
Html.tag_attrs Text
"input" (Text -> [(Text, Text)]
forall {a}. IsString a => Text -> [(a, Text)]
attrs Text
val) (Html -> Maybe Html
forall a. a -> Maybe a
Just (Text -> Html
Html.html Text
val))
    attrs :: Text -> [(a, Text)]
attrs Text
val =
        [ (a
"type", Text
"radio")
        , (a
"onchange", Text
"showAbstraction('" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
instrument Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"', this.value)")
        , (a
"name", Text
"abstraction-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
instrument)
        , (a
"value", Text
val)
        ] [(a, Text)] -> [(a, Text)] -> [(a, Text)]
forall a. [a] -> [a] -> [a]
++ if Text
val Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
defaultAbstraction then [(a
"checked", Text
"")] else []

htmlFooter :: Html.Html
htmlFooter :: Html
htmlFooter = Html
"</body></html>\n"

allCss :: Html.Html
allCss :: Html
allCss = Html -> [Html] -> Html
forall a. Textlike a => a -> [a] -> a
Texts.join Html
"\n" [Html
tableCss, Text -> Html
Html.Html Text
typeCss]

tableCss :: Html.Html
tableCss :: Html
tableCss =
    Html
"table.konnakol {\n\
    \   table-layout: fixed;\n\
    \   width: 100%;\n\
    \}\n\
    \table.konnakol th {\n\
    \   text-align: left;\n\
    \   border-bottom: 1px solid;\n\
    \}\n\
    \.onAnga { border-left: 3px double }\n\
    \.onAkshara { border-left: 1px solid }\n\
    \.finalLine { border-bottom: 1px solid gray; }\n"

-- | Unused, because I don't really like the tooltips.
_metadataCss :: Html.Html
_metadataCss :: Html
_metadataCss =
    Html
".tooltip {\n\
    \    position: relative;\n\
    \    display: inline-block;\n\
    \}\n\
    \.tooltip .tooltiptext {\n\
    \    visibility: hidden;\n\
    \    width: 120px;\n\
    \    background-color: black;\n\
    \    color: #fff;\n\
    \    text-align: center;\n\
    \    padding: 5px 0;\n\
    \    border-radius: 6px;\n\
    \    position: absolute;\n\
    \    z-index: 1;\n\
    \    left: 105%;\n\
    \    bottom: 100%;\n\
    \}\n\
    \.tooltip:hover .tooltiptext {\n\
    \    visibility: visible;\n\
    \}\n"

typeCss :: Text
typeCss :: Text
typeCss = [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ GroupType -> Text -> Text -> [Text]
styles GroupType
gtype (RgbColor -> Text
cssColor RgbColor
start) (RgbColor -> Text
cssColor RgbColor
end)
    | ((RgbColor
start, RgbColor
end), GroupType
gtype) <- (GroupType -> (RgbColor, RgbColor))
-> [GroupType] -> [((RgbColor, RgbColor), GroupType)]
forall a k. (a -> k) -> [a] -> [(k, a)]
Seq.key_on GroupType -> (RgbColor, RgbColor)
typeColors [GroupType]
Solkattu.groupTypes
    ]
    where
    styles :: GroupType -> Text -> Text -> [Text]
styles GroupType
gtype Text
start Text
end =
        [ Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
Start
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" { background: linear-gradient(to right, "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") }"
        , Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
In Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" { background-color: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" }"
        , Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
End
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" { background: linear-gradient(to right, "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", white) }"
        ]
    cssColor :: RgbColor -> Text
cssColor RgbColor
c = Text
"rgb(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " ((Float -> Text) -> [Float] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Float -> Text
to8 [Float
r, Float
g, Float
b]) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        where (Float
r, Float
g, Float
b) = RgbColor -> (Float, Float, Float)
Styled.toRgb RgbColor
c
    to8 :: Float -> Text
to8 = Integer -> Text
forall a. Show a => a -> Text
showt (Integer -> Text) -> (Float -> Integer) -> Float -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Integer) -> (Float -> Float) -> Float -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
255)

data Pos = Start | In | End
    deriving (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
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 -> FilePath
(Int -> Pos -> ShowS)
-> (Pos -> FilePath) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> FilePath
$cshow :: Pos -> FilePath
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show)

-- | Get the class name for a GroupType at the Start, In, or End of the
-- highlight.
groupStyle :: Solkattu.GroupType -> Pos -> Text
groupStyle :: GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
pos = Text
"g" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupType -> Text
forall a. Show a => a -> Text
showt GroupType
gtype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Pos -> Text
forall a. Show a => a -> Text
showt Pos
pos

typeColors :: Solkattu.GroupType -> (Styled.RgbColor, Styled.RgbColor)
typeColors :: GroupType -> (RgbColor, RgbColor)
typeColors = \case
    GroupType
Solkattu.GGroup -> (RgbColor, RgbColor)
groupc
    GroupType
Solkattu.GReductionT -> (RgbColor, RgbColor)
groupc
    GroupType
Solkattu.GFiller -> RgbColor -> (RgbColor, RgbColor)
forall {b}. b -> (b, b)
both (RgbColor -> (RgbColor, RgbColor))
-> RgbColor -> (RgbColor, RgbColor)
forall a b. (a -> b) -> a -> b
$ Float -> RgbColor
gray Float
0.9
    GroupType
Solkattu.GPattern -> (RgbColor, RgbColor)
patternc
    GroupType
Solkattu.GExplicitPattern -> (RgbColor, RgbColor)
patternc
    GroupType
Solkattu.GSarva -> RgbColor -> (RgbColor, RgbColor)
forall {b}. b -> (b, b)
both (RgbColor -> (RgbColor, RgbColor))
-> RgbColor -> (RgbColor, RgbColor)
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> RgbColor
rgb Float
0.7 Float
0.85 Float
0.7
    -- This shouldn't be here, so make it red.
    Solkattu.GCheckDuration {} -> RgbColor -> (RgbColor, RgbColor)
forall {b}. b -> (b, b)
both (RgbColor -> (RgbColor, RgbColor))
-> RgbColor -> (RgbColor, RgbColor)
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> RgbColor
rgb Float
0.75 Float
0 Float
0
    where
    groupc :: (RgbColor, RgbColor)
groupc = (Float -> Float -> Float -> RgbColor
rgb Float
0.5 Float
0.8 Float
0.5, Float -> RgbColor
gray Float
0.8)
    patternc :: (RgbColor, RgbColor)
patternc = (Float -> Float -> Float -> RgbColor
rgb Float
0.65 Float
0.65 Float
0.8, Float -> Float -> Float -> RgbColor
rgb Float
0.8 Float
0.8 Float
0.95)
    both :: b -> (b, b)
both b
n = (b
n, b
n)
    rgb :: Float -> Float -> Float -> RgbColor
rgb = Float -> Float -> Float -> RgbColor
Styled.rgbColor
    gray :: Float -> RgbColor
gray Float
n = Float -> Float -> Float -> RgbColor
rgb Float
n Float
n Float
n

-- * render

-- | TODO unused, later I should filter out only the interesting ones and
-- cram them in per-section inline
_sectionMetadata :: Korvai.Section sollu -> Html.Html
_sectionMetadata :: forall sollu. Section sollu -> Html
_sectionMetadata Section sollu
section = Html -> [Html] -> Html
forall a. Textlike a => a -> [a] -> a
Texts.join Html
"; " ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((Text, [Text]) -> Html) -> [(Text, [Text])] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Text]) -> Html
showTag (Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text [Text]
tags)
    where
    tags :: Map Text [Text]
tags = Tags -> Map Text [Text]
Tags.untags (Tags -> Map Text [Text]) -> Tags -> Map Text [Text]
forall a b. (a -> b) -> a -> b
$ Section sollu -> Tags
forall a. Section a -> Tags
Korvai.sectionTags Section sollu
section
    showTag :: (Text, [Text]) -> Html
showTag (Text
k, []) = Text -> Html
Html.html Text
k
    showTag (Text
k, [Text]
vs) = Text -> Html
Html.html Text
k Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": "
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> [Html] -> Html
forall a. Textlike a => a -> [a] -> a
Texts.join Html
", " ((Text -> Html) -> [Text] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Html
htmlTag Text
k) [Text]
vs)

scoreMetadata :: Korvai.Score -> [Html.Html]
scoreMetadata :: Score -> [Html]
scoreMetadata Score
score = (Html -> Html) -> [Html] -> [Html]
forall a. (a -> a) -> [a] -> [a]
Seq.map_init (Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>Html
"<br>") ([Html] -> [Html]) -> [Html] -> [Html]
forall a b. (a -> b) -> a -> b
$ [[Html]] -> [Html]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Html]] -> [Html]) -> [[Html]] -> [Html]
forall a b. (a -> b) -> a -> b
$
    [ [Html
"Tala: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html (Text -> [Text] -> Text
Text.intercalate Text
", " (Score -> [Text]
scoreTalas Score
score))]
    , [Html
"Date: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html (Day -> Text
showDate Day
date) | Just Day
date <- [Score -> Maybe Day
scoreDate Score
score]]
    , [(Text, [Text]) -> Html
showTag (Text
"Eddupu", (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. Pretty a => a -> Text
pretty [Text]
eddupus) | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
eddupus)]
    , ((Text, [Text]) -> Html) -> [(Text, [Text])] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Text]) -> Html
showTag (Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Text -> Map Text [Text] -> Map Text [Text]
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"tala" Map Text [Text]
tags))
    ]
    where
    eddupus :: [Text]
eddupus = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
Seq.unique ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
"0") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text -> Map Text [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
Tags.eddupu Map Text [Text]
sectionTags
    sectionTags :: Map Text [Text]
sectionTags = Tags -> Map Text [Text]
Tags.untags (Tags -> Map Text [Text]) -> Tags -> Map Text [Text]
forall a b. (a -> b) -> a -> b
$ [Tags] -> Tags
forall a. Monoid a => [a] -> a
mconcat ([Tags] -> Tags) -> [Tags] -> Tags
forall a b. (a -> b) -> a -> b
$
        Score -> [Tags]
Metadata.sectionTags Score
score
    tags :: Map Text [Text]
tags = Tags -> Map Text [Text]
Tags.untags (Tags -> Map Text [Text]) -> Tags -> Map Text [Text]
forall a b. (a -> b) -> a -> b
$ Metadata -> Tags
Korvai._tags Metadata
meta
    meta :: Metadata
meta = Score -> Metadata
Korvai.scoreMetadata Score
score
    showTag :: (Text, [Text]) -> Html
showTag (Text
k, []) = Text -> Html
Html.html Text
k
    showTag (Text
k, [Text]
vs) = Text -> Html
Html.html Text
k Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
": "
        Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html -> [Html] -> Html
forall a. Textlike a => a -> [a] -> a
Texts.join Html
", " ((Text -> Html) -> [Text] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Html
htmlTag Text
k) [Text]
vs)

showDate :: Calendar.Day -> Text
showDate :: Day -> Text
showDate = FilePath -> Text
txt (FilePath -> Text) -> (Day -> FilePath) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> FilePath
Calendar.showGregorian

scoreTalas :: Korvai.Score -> [Text]
scoreTalas :: Score -> [Text]
scoreTalas = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
Seq.unique ([Text] -> [Text]) -> (Score -> [Text]) -> Score -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Korvai -> Text) -> [Korvai] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Tala -> Text
Tala.tala_name (Tala -> Text) -> (Korvai -> Tala) -> Korvai -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Korvai -> Tala
Korvai.korvaiTala)
    ([Korvai] -> [Text]) -> (Score -> [Korvai]) -> Score -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> [Korvai]
Korvai.scoreKorvais

formatAvartanams :: Solkattu.Notation stroke => Config -> S.Speed
    -> Format.PrevRuler -> Tala.Tala
    -> [S.Flat Solkattu.Meta (Realize.Note stroke)]
    -> (Format.PrevRuler, [(Maybe Format.Ruler, Line)])
formatAvartanams :: forall stroke.
Notation stroke =>
Config
-> Int
-> PrevRuler
-> Tala
-> [Flat Meta (Note stroke)]
-> (PrevRuler, [(Maybe Ruler, [(State, Symbol)])])
formatAvartanams Config
config Int
toSpeed PrevRuler
prevRuler Tala
tala =
    ([[(Maybe Ruler, [(State, Symbol)])]]
 -> [(Maybe Ruler, [(State, Symbol)])])
-> (PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]])
-> (PrevRuler, [(Maybe Ruler, [(State, Symbol)])])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [[(Maybe Ruler, [(State, Symbol)])]]
-> [(Maybe Ruler, [(State, Symbol)])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    ((PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]])
 -> (PrevRuler, [(Maybe Ruler, [(State, Symbol)])]))
-> ([Flat Meta (Note stroke)]
    -> (PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]]))
-> [Flat Meta (Note stroke)]
-> (PrevRuler, [(Maybe Ruler, [(State, Symbol)])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> PrevRuler
-> Tala
-> Int
-> [[[(State, Symbol)]]]
-> (PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]])
forall sym.
Int
-> PrevRuler
-> Tala
-> Int
-> [[Line sym]]
-> (PrevRuler, [[(Maybe Ruler, Line sym)]])
Format.pairWithRuler (Config -> Int
_rulerEach Config
config) PrevRuler
prevRuler Tala
tala Int
1
    ([[[(State, Symbol)]]]
 -> (PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]]))
-> ([Flat Meta (Note stroke)] -> [[[(State, Symbol)]]])
-> [Flat Meta (Note stroke)]
-> (PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Bool) -> [[[(State, Symbol)]]] -> [[[(State, Symbol)]]]
forall note a. (note -> Bool) -> [[[(a, note)]]] -> [[[(a, note)]]]
Format.formatFinalAvartanam (Html -> Bool
isRest (Html -> Bool) -> (Symbol -> Html) -> Symbol -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Html
_html) ([[[(State, Symbol)]]] -> [[[(State, Symbol)]]])
-> ([Flat Meta (Note stroke)] -> [[[(State, Symbol)]]])
-> [Flat Meta (Note stroke)]
-> [[[(State, Symbol)]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(State, Symbol)] -> [[(State, Symbol)]])
-> [[(State, Symbol)]] -> [[[(State, Symbol)]]]
forall a b. (a -> b) -> [a] -> [b]
map ([(State, Symbol)] -> [[(State, Symbol)]] -> [[(State, Symbol)]]
forall a. a -> [a] -> [a]
:[])
    ([[(State, Symbol)]] -> [[[(State, Symbol)]]])
-> ([Flat Meta (Note stroke)] -> [[(State, Symbol)]])
-> [Flat Meta (Note stroke)]
-> [[[(State, Symbol)]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(State, Symbol)] -> [[(State, Symbol)]]
forall a. [(State, a)] -> [[(State, a)]]
Format.breakAvartanams
    ([(State, Symbol)] -> [[(State, Symbol)]])
-> ([Flat Meta (Note stroke)] -> [(State, Symbol)])
-> [Flat Meta (Note stroke)]
-> [[(State, Symbol)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedFlat stroke -> [(State, Symbol)])
-> [NormalizedFlat stroke] -> [(State, Symbol)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NormalizedFlat stroke -> [(State, Symbol)]
forall stroke.
Notation stroke =>
NormalizedFlat stroke -> [(State, Symbol)]
makeSymbols
    ([NormalizedFlat stroke] -> [(State, Symbol)])
-> ([Flat Meta (Note stroke)] -> [NormalizedFlat stroke])
-> [Flat Meta (Note stroke)]
-> [(State, Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abstraction -> [NormalizedFlat stroke] -> [NormalizedFlat stroke]
forall stroke.
Abstraction -> [NormalizedFlat stroke] -> [NormalizedFlat stroke]
Format.makeGroupsAbstract (Config -> Abstraction
_abstraction Config
config)
    ([NormalizedFlat stroke] -> [NormalizedFlat stroke])
-> ([Flat Meta (Note stroke)] -> [NormalizedFlat stroke])
-> [Flat Meta (Note stroke)]
-> [NormalizedFlat stroke]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tala -> [Flat Meta (Note stroke)] -> [NormalizedFlat stroke]
forall stroke.
Int -> Tala -> [Flat stroke] -> [NormalizedFlat stroke]
Format.normalizeSpeed Int
toSpeed Tala
tala

type Line = [(S.State, Symbol)]

data Symbol = Symbol {
    Symbol -> Html
_html :: !Html.Html
    , Symbol -> Bool
_isSustain :: !Bool
    , Symbol -> Maybe Text
_style :: !(Maybe Text)
    } deriving (Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> FilePath
(Int -> Symbol -> ShowS)
-> (Symbol -> FilePath) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> FilePath
$cshow :: Symbol -> FilePath
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show)

instance Pretty Symbol where
    pretty :: Symbol -> Text
pretty (Symbol Html
html Bool
_ Maybe Text
_) = Html -> Text
forall a. Pretty a => a -> Text
pretty Html
html

-- | Flatten the groups into linear [Symbol].
makeSymbols :: Solkattu.Notation stroke => Format.NormalizedFlat stroke
    -> [(S.State, Symbol)]
makeSymbols :: forall stroke.
Notation stroke =>
NormalizedFlat stroke -> [(State, Symbol)]
makeSymbols = Flat Meta (State, Stroke (Note stroke)) -> [(State, Symbol)]
forall stroke.
Notation stroke =>
NormalizedFlat stroke -> [(State, Symbol)]
go
    where
    go :: Flat Meta (State, Stroke (Note stroke)) -> [(State, Symbol)]
go (S.FNote Tempo
_ (State
state, Stroke (Note stroke)
note_)) =
        ((State, Symbol) -> [(State, Symbol)] -> [(State, Symbol)]
forall a. a -> [a] -> [a]
:[]) ((State, Symbol) -> [(State, Symbol)])
-> (State, Symbol) -> [(State, Symbol)]
forall a b. (a -> b) -> a -> b
$ (State
state,) (Symbol -> (State, Symbol)) -> Symbol -> (State, Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol
            { _html :: Html
_html = State -> Stroke (Note stroke) -> Html
forall {stroke}.
Notation stroke =>
State -> Stroke (Note stroke) -> Html
noteHtml State
state Stroke (Note stroke)
note
            , _isSustain :: Bool
_isSustain = case Stroke (Note stroke)
note of
                S.Sustain {} -> Bool
True
                Stroke (Note stroke)
_ -> Bool
False
            , _style :: Maybe Text
_style = Maybe Text
forall a. Maybe a
Nothing
            }
        where note :: Stroke (Note stroke)
note = Stroke (Note stroke) -> Stroke (Note stroke)
forall {stroke}. Stroke (Note stroke) -> Stroke (Note stroke)
normalizeSarva Stroke (Note stroke)
note_
    go (S.FGroup Tempo
_ Meta
group [Flat Meta (State, Stroke (Note stroke))]
children) = [(State, Symbol)] -> [(State, Symbol)]
forall {a}. [(a, Symbol)] -> [(a, Symbol)]
modify ((Flat Meta (State, Stroke (Note stroke)) -> [(State, Symbol)])
-> [Flat Meta (State, Stroke (Note stroke))] -> [(State, Symbol)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flat Meta (State, Stroke (Note stroke)) -> [(State, Symbol)]
go [Flat Meta (State, Stroke (Note stroke))]
children)
        where
        modify :: [(a, Symbol)] -> [(a, Symbol)]
modify = case Meta -> GroupType
Solkattu._type Meta
group of
            -- Highlight only when non-abstract.
            GroupType
Solkattu.GSarva -> case [Flat Meta (State, Stroke (Note stroke))]
children of
                S.FNote Tempo
_ (State
_, S.Attack (Realize.Abstract {})) : [Flat Meta (State, Stroke (Note stroke))]
_ -> [(a, Symbol)] -> [(a, Symbol)]
forall a. a -> a
id
                [Flat Meta (State, Stroke (Note stroke))]
_ -> GroupType -> [(a, Symbol)] -> [(a, Symbol)]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
GroupType -> [p a Symbol] -> [p a Symbol]
setStyle GroupType
Solkattu.GSarva
            GroupType
gtype -> GroupType -> [(a, Symbol)] -> [(a, Symbol)]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
GroupType -> [p a Symbol] -> [p a Symbol]
setStyle GroupType
gtype
    setStyle :: GroupType -> [p a Symbol] -> [p a Symbol]
setStyle GroupType
gtype = (p a Symbol -> p a Symbol) -> [p a Symbol] -> [p a Symbol]
forall a. (a -> a) -> [a] -> [a]
Seq.map_last ((Symbol -> Symbol) -> p a Symbol -> p a Symbol
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Pos -> Symbol -> Symbol
set Pos
End))
        ([p a Symbol] -> [p a Symbol])
-> ([p a Symbol] -> [p a Symbol]) -> [p a Symbol] -> [p a Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a Symbol -> p a Symbol)
-> (p a Symbol -> p a Symbol) -> [p a Symbol] -> [p a Symbol]
forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
Seq.map_head_tail ((Symbol -> Symbol) -> p a Symbol -> p a Symbol
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Pos -> Symbol -> Symbol
set Pos
Start)) ((Symbol -> Symbol) -> p a Symbol -> p a Symbol
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Pos -> Symbol -> Symbol
set Pos
In))
        where set :: Pos -> Symbol -> Symbol
set Pos
pos Symbol
sym = Symbol
sym { _style :: Maybe Text
_style = Text -> Maybe Text
forall a. a -> Maybe a
Just (GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
pos) }
    noteHtml :: State -> Stroke (Note stroke) -> Html
noteHtml State
state = \case
        S.Sustain (Realize.Abstract Meta
meta) -> case Meta -> GroupType
Solkattu._type Meta
meta of
            -- TODO this is actually pretty ugly
            GroupType
Solkattu.GSarva -> Html
"<hr style=\"border: 4px dotted\">"
            GroupType
_ -> Html
"<hr noshade>"
        S.Sustain Note stroke
a -> State -> Note stroke -> Html
forall {p}. Notation p => State -> p -> Html
notation State
state Note stroke
a
        S.Attack Note stroke
a -> State -> Note stroke -> Html
forall {p}. Notation p => State -> p -> Html
notation State
state Note stroke
a
        Stroke (Note stroke)
S.Rest -> Text -> Html
Html.html Text
"_"
    -- Because sarva is <hr> all the way through, don't separate the attack
    -- from sustain.
    normalizeSarva :: Stroke (Note stroke) -> Stroke (Note stroke)
normalizeSarva (S.Attack n :: Note stroke
n@(Realize.Abstract Meta
meta))
        | Meta -> GroupType
Solkattu._type Meta
meta GroupType -> GroupType -> Bool
forall a. Eq a => a -> a -> Bool
== GroupType
Solkattu.GSarva = Note stroke -> Stroke (Note stroke)
forall a. a -> Stroke a
S.Sustain Note stroke
n
    normalizeSarva Stroke (Note stroke)
n = Stroke (Note stroke)
n
    notation :: State -> p -> Html
notation State
state p
n = Style -> Html -> Html
Styled.styleHtml Style
style (Text -> Html
Html.html Text
notation)
        where
        style :: Style
style
            | State -> Bool
Format.onAkshara State
state = Style
noteStyle { _bold :: Bool
Styled._bold = Bool
True }
            | Bool
otherwise = Style
noteStyle
        (Style
noteStyle, Text
notation) = p -> (Style, Text)
forall a. Notation a => a -> (Style, Text)
Solkattu.notation p
n

formatTable :: Tala.Tala -> Int -> Korvai.Section ()
    -> [(Maybe Format.Ruler, [(S.State, Symbol)])] -> [(Bool, [Html.Html])]
formatTable :: Tala
-> Int
-> Section ()
-> [(Maybe Ruler, [(State, Symbol)])]
-> [(Bool, [Html])]
formatTable Tala
tala Int
_sectionIndex Section ()
section [(Maybe Ruler, [(State, Symbol)])]
rows = ((Bool, (Maybe Ruler, [(State, Symbol)]), Bool) -> (Bool, [Html]))
-> [(Bool, (Maybe Ruler, [(State, Symbol)]), Bool)]
-> [(Bool, [Html])]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (Maybe Ruler, [(State, Symbol)]), Bool) -> (Bool, [Html])
row ([(Bool, (Maybe Ruler, [(State, Symbol)]), Bool)]
 -> [(Bool, [Html])])
-> [(Bool, (Maybe Ruler, [(State, Symbol)]), Bool)]
-> [(Bool, [Html])]
forall a b. (a -> b) -> a -> b
$ [(Maybe Ruler, [(State, Symbol)])]
-> [(Bool, (Maybe Ruler, [(State, Symbol)]), Bool)]
forall a. [a] -> [(Bool, a, Bool)]
zipFirstFinal [(Maybe Ruler, [(State, Symbol)])]
rows
    where
    td :: ([(Text, Text)], Html) -> Html
td ([(Text, Text)]
tags, Html
body) = Text -> [(Text, Text)] -> Maybe Html -> Html
Html.tag_attrs Text
"td" [(Text, Text)]
tags (Html -> Maybe Html
forall a. a -> Maybe a
Just Html
body)
    row :: (Bool, (Maybe Ruler, [(State, Symbol)]), Bool) -> (Bool, [Html])
row (Bool
isFirst, (Maybe Ruler
mbRuler, [(State, Symbol)]
cells), Bool
isFinal) = case Maybe Ruler
mbRuler of
        Just Ruler
ruler ->
            ( Bool
True
            , Html
"<tr><td></td>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Ruler -> Html
formatRuler Ruler
ruler Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</tr>" Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [Html]
notes
            )
        Maybe Ruler
Nothing -> (Bool
False, [Html]
notes)
        where
        notes :: [Html]
notes = (Html
"<tr><td>" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Bool -> Html
sectionTags Bool
isFirst Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
"</td>") Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [Html]
cellTds
            [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html
"</tr>\n"]
        cellTds :: [Html]
cellTds = (([(Text, Text)], Html) -> Html)
-> [([(Text, Text)], Html)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ([(Text, Text)], Html) -> Html
td ([([(Text, Text)], Html)] -> [Html])
-> ([(State, Symbol)] -> [([(Text, Text)], Html)])
-> [(State, Symbol)]
-> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Html)] -> [Html])
-> [([(Text, Text)], (Int, Html))] -> [([(Text, Text)], Html)]
forall a b x. ([a] -> [b]) -> [(x, a)] -> [(x, b)]
Format.mapSnd [(Int, Html)] -> [Html]
spellRests
            ([([(Text, Text)], (Int, Html))] -> [([(Text, Text)], Html)])
-> ([(State, Symbol)] -> [([(Text, Text)], (Int, Html))])
-> [(State, Symbol)]
-> [([(Text, Text)], Html)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, (State, Symbol))] -> ([(Text, Text)], (Int, Html)))
-> [[(Int, (State, Symbol))]] -> [([(Text, Text)], (Int, Html))]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [(Int, (State, Symbol))] -> ([(Text, Text)], (Int, Html))
mkCell Bool
isFinal) ([[(Int, (State, Symbol))]] -> [([(Text, Text)], (Int, Html))])
-> ([(State, Symbol)] -> [[(Int, (State, Symbol))]])
-> [(State, Symbol)]
-> [([(Text, Text)], (Int, Html))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (State, Symbol)) -> (Int, (State, Symbol)) -> Bool)
-> [(Int, (State, Symbol))] -> [[(Int, (State, Symbol))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (Int, (State, Symbol)) -> (Int, (State, Symbol)) -> Bool
forall {a} {a} {a}.
(a, (a, Symbol)) -> (a, (State, Symbol)) -> Bool
merge ([(Int, (State, Symbol))] -> [[(Int, (State, Symbol))]])
-> ([(State, Symbol)] -> [(Int, (State, Symbol))])
-> [(State, Symbol)]
-> [[(Int, (State, Symbol))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [(State, Symbol)] -> [(Int, (State, Symbol))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(State, Symbol)] -> [Html]) -> [(State, Symbol)] -> [Html]
forall a b. (a -> b) -> a -> b
$ [(State, Symbol)]
cells
    sectionTags :: Bool -> Html
sectionTags Bool
isFirst
        | Bool -> Bool
not Bool
isFirst Bool -> Bool -> Bool
|| Text -> Bool
Text.null Text
tags = Html
""
        | Bool
otherwise = Text -> [(Text, Text)] -> Maybe Html -> Html
Html.tag_attrs Text
"span" [(Text
"style", Text
"font-size:50%")] (Maybe Html -> Html) -> Maybe Html -> Html
forall a b. (a -> b) -> a -> b
$
            Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
Html.html Text
tags
        where tags :: Text
tags = Tags -> Text
Format.showTags (Section () -> Tags
forall a. Section a -> Tags
Korvai.sectionTags Section ()
section)
    -- Merge together the sustains after an attack.  They will likely have an
    -- <hr> in them, which will expand to the full colspan width.
    merge :: (a, (a, Symbol)) -> (a, (State, Symbol)) -> Bool
merge (a
_, (a
_, Symbol
sym1)) (a
_, (State
state2, Symbol
sym2)) =
        Symbol -> Bool
_isSustain Symbol
sym1 Bool -> Bool -> Bool
&& Symbol -> Bool
_isSustain Symbol
sym2 Bool -> Bool -> Bool
&& Bool -> Bool
not (State -> Bool
Format.onAkshara State
state2)
        -- Split sustains on aksharas.  Otherwise, the colspan prevents the
        -- vertical lines that mark them.
    mkCell :: Bool -> [(Int, (S.State, Symbol))]
        -> ([(Text, Text)], (Int, Html.Html))
    mkCell :: Bool -> [(Int, (State, Symbol))] -> ([(Text, Text)], (Int, Html))
mkCell Bool
_ [] = ([], (Int
0, Html
"")) -- List.groupBy shouldn't return empty groups
    mkCell Bool
isFinal syms :: [(Int, (State, Symbol))]
syms@((Int
index, (State
state, Symbol
sym)) : [(Int, (State, Symbol))]
_) = ([(Text, Text)]
tags, (Int
index, Symbol -> Html
_html Symbol
sym))
        where
        tags :: [(Text, Text)]
tags = [[(Text, Text)]] -> [(Text, Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [(Text
"class", [Text] -> Text
Text.unwords [Text]
classes) | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes)]
            , [(Text
"colspan", Int -> Text
forall a. Show a => a -> Text
showt Int
cells) | Int
cells Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1]
            ]
            where cells :: Int
cells = [(Int, (State, Symbol))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, (State, Symbol))]
syms
        classes :: [Text]
classes = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ if
                | Set Int -> State -> Bool
Format.onAnga Set Int
angas State
state -> [Text
"onAnga"]
                | State -> Bool
Format.onAkshara State
state -> [Text
"onAkshara"]
                | Bool
otherwise -> []
            , [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Symbol -> Maybe Text
_style Symbol
sym)
            , [Text
"finalLine" | Bool
isFinal]
            ]
    angas :: Set Int
angas = Tala -> Set Int
Format.angaSet Tala
tala

zipFirstFinal :: [a] -> [(Bool, a, Bool)]
zipFirstFinal :: forall a. [a] -> [(Bool, a, Bool)]
zipFirstFinal =
    ((Maybe a, a, Maybe a) -> (Bool, a, Bool))
-> [(Maybe a, a, Maybe a)] -> [(Bool, a, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe a
prev, a
x, Maybe a
next) -> (Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe a
prev, a
x, Maybe a -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe a
next))
    ([(Maybe a, a, Maybe a)] -> [(Bool, a, Bool)])
-> ([a] -> [(Maybe a, a, Maybe a)]) -> [a] -> [(Bool, a, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [(Maybe a, a, Maybe a)]
forall a. [a] -> [(Maybe a, a, Maybe a)]
Seq.zip_neighbors

formatRuler :: Format.Ruler -> Html.Html
formatRuler :: Ruler -> Html
formatRuler =
    ((Text, Bool) -> Html) -> [(Text, Bool)] -> Html
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (Text, Bool) -> Html
mark ([(Text, Bool)] -> Html)
-> (Ruler -> [(Text, Bool)]) -> Ruler -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Maybe Text) -> (Text, Bool))
-> [(Text, Maybe Text)] -> [(Text, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Text -> Bool) -> (Text, Maybe Text) -> (Text, Bool)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Maybe Text -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing) ([(Text, Maybe Text)] -> [(Text, Bool)])
-> (Ruler -> [(Text, Maybe Text)]) -> Ruler -> [(Text, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [(Text, Maybe Text)]
forall a. [a] -> [(a, Maybe a)]
Seq.zip_next
    ([Text] -> [(Text, Maybe Text)])
-> (Ruler -> [Text]) -> Ruler -> [(Text, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Int) -> [Text]) -> Ruler -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Int) -> [Text]
akshara
    where
    -- If the final one is th, then it omits the underline, which looks a bit
    -- nicer.
    mark :: (Text, Bool) -> Html
mark (Text
m, Bool
isFinal) = Text -> Html -> Html
Html.tag (if Bool
isFinal then Text
"td" else Text
"th") (Text -> Html
Html.html Text
m)
    akshara :: (Text, Int) -> [Text]
    akshara :: (Text, Int) -> [Text]
akshara (Text
n, Int
spaces) = Text
n Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate (Int
spacesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Text
""

-- | This is the HTML version of 'Terminal.spellRests'.
--
-- It uses 3 levels of rests: space, single, and double.
spellRests :: [(Int, Html.Html)] -> [Html.Html]
spellRests :: [(Int, Html)] -> [Html]
spellRests = [(Int, Html)] -> [Html]
spell
    where
    spell :: [(Int, Html)] -> [Html]
spell [] = []
    spell ((Int
col, Html
sym) : [(Int, Html)]
syms)
        | Bool -> Bool
not (Html -> Bool
isRest Html
sym) = Html
sym Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [(Int, Html)] -> [Html]
spell [(Int, Html)]
syms
        | Just [(Int, Html)]
post <- Int -> [(Int, Html)] -> Int -> Maybe [(Int, Html)]
forall {a}. Int -> [(a, Html)] -> Int -> Maybe [(a, Html)]
checkRests Int
col [(Int, Html)]
syms Int
4 =
            (Html
double Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Int -> Html -> [Html]
forall a. Int -> a -> [a]
replicate Int
3 Html
"") [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [(Int, Html)] -> [Html]
spell [(Int, Html)]
post
        | Just [(Int, Html)]
post <- Int -> [(Int, Html)] -> Int -> Maybe [(Int, Html)]
forall {a}. Int -> [(a, Html)] -> Int -> Maybe [(a, Html)]
checkRests Int
col [(Int, Html)]
syms Int
2 =
            Html
single Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Html
"" Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [(Int, Html)] -> [Html]
spell [(Int, Html)]
post
        | Bool
otherwise = Html
"" Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [(Int, Html)] -> [Html]
spell [(Int, Html)]
syms
    checkRests :: Int -> [(a, Html)] -> Int -> Maybe [(a, Html)]
checkRests Int
col [(a, Html)]
syms Int
n
        | Int
col Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& [(a, Html)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, Html)]
rests Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = [(a, Html)] -> Maybe [(a, Html)]
forall a. a -> Maybe a
Just ([(a, Html)] -> Maybe [(a, Html)])
-> [(a, Html)] -> Maybe [(a, Html)]
forall a b. (a -> b) -> a -> b
$ Int -> [(a, Html)] -> [(a, Html)]
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [(a, Html)]
syms
        | Bool
otherwise = Maybe [(a, Html)]
forall a. Maybe a
Nothing
        where
        rests :: [(a, Html)]
rests = Int -> [(a, Html)] -> [(a, Html)]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([(a, Html)] -> [(a, Html)]) -> [(a, Html)] -> [(a, Html)]
forall a b. (a -> b) -> a -> b
$ ((a, Html) -> Bool) -> [(a, Html)] -> [(a, Html)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Html -> Bool
isRest (Html -> Bool) -> ((a, Html) -> Html) -> (a, Html) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Html) -> Html
forall a b. (a, b) -> b
snd) [(a, Html)]
syms
    double :: Html
double = Text -> Html
Html.html (Char -> Text
Text.singleton Char
Realize.doubleRest)
    single :: Html
single = Html
"_"

isRest :: Html.Html -> Bool
isRest :: Html -> Bool
isRest = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"_") (Text -> Bool) -> (Html -> Text) -> Html -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
Html.un_html


-- * implementation

konnakolFont, instrumentFont :: Font
konnakolFont :: Font
konnakolFont = Font
    { _sizePercent :: Int
_sizePercent = Int
75
    , _monospace :: Bool
_monospace = Bool
False
    }
instrumentFont :: Font
instrumentFont = Font
    { _sizePercent :: Int
_sizePercent = Int
125
    , _monospace :: Bool
_monospace = Bool
True
    }

htmlTag :: Text -> Text -> Html.Html
htmlTag :: Text -> Text -> Html
htmlTag Text
k Text
v
    | Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
Tags.recording = case Text -> Maybe (Text, Maybe (Time, Time))
Metadata.parseRecording Text
v of
        Maybe (Text, Maybe (Time, Time))
Nothing -> Text -> Html
Html.html (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"can't parse: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
        Just (Text
url, Maybe (Time, Time)
range) -> Text -> Html
link (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe (Time, Time)
range of
            Maybe (Time, Time)
Nothing -> Text
""
            -- TODO assuming youtube
            Just (Time
start, Time
_) -> Text
"#t=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Stack => Time -> Text
Time -> Text
Metadata.showTime Time
start
    | Bool
otherwise = Text -> Html
Html.html Text
v
    where
    link :: Text -> Html
link Text
s = Text -> Text -> Html
Html.link Text
s Text
s