{-# LANGUAGE CPP #-}
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.Files as Files
import qualified Util.Html as Html
import qualified Util.Lists as Lists
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.Talas as Talas
import Global
indexHtml :: (Korvai.Score -> FilePath) -> [Korvai.Score] -> Html.Html
indexHtml :: (Score -> FilePath) -> [Score] -> Html
indexHtml Score -> FilePath
scoreFname [Score]
scores = forall a. Textlike a => a -> [a] -> a
Texts.join Html
"\n" 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>" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Html
"<th>" forall a. Semigroup a => a -> a -> a
<> Html
c forall a. Semigroup a => a -> a -> a
<> Html
"</th>" | (Html
c, Score -> Html
_) <- [(Html, Score -> Html)]
columns] forall a. Semigroup a => a -> a -> a
<> Html
"</tr>"
] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Score -> Html
row (forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn Score -> Maybe Day
scoreDate [Score]
scores) forall a. [a] -> [a] -> [a]
++
[ Html
"</table>"
, Html
"<script>"
, Html
javascriptIndex
, Html
"</script>"
, Html
"</body></html>"
]
where
row :: Score -> Html
row Score
score = forall a. Monoid a => [a] -> a
mconcat
[ Html
"<tr>"
, forall a. Monoid a => [a] -> a
mconcat [Html
"<td>" forall a. Semigroup a => a -> a -> a
<> Score -> Html
cellOf Score
score 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"type")
, (Html
"tala", [Text] -> Html
commas forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> [Text]
scoreTalas)
, (Html
"nadai", [Text] -> Html
commas forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.sectionTag Text
"nadai")
, (Html
"avart", [Text] -> Html
commas forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"avartanams")
, (Html
"date", Text -> Html
Html.html forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Day -> Text
showDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> Maybe Day
scoreDate)
, (Html
"instruments", [Text] -> Html
commas forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Score -> [Text]
Metadata.scoreTag Text
"instrument")
, (Html
"source", [Text] -> Html
commas 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 forall a b. (a -> b) -> a -> b
$ Score -> Metadata
Korvai.scoreMetadata Score
score
commas :: [Text] -> Html
commas = Text -> Html
Html.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 -> forall a. a -> Maybe a
Just Day
day
Maybe Day
Nothing -> forall a. Ord a => [a] -> Maybe a
Lists.maximum forall a b. (a -> b) -> a -> b
$ 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 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"
writeAll :: FilePath -> Korvai.Score -> IO ()
writeAll :: FilePath -> Score -> IO ()
writeAll FilePath
fname Score
score = FilePath -> [Text] -> IO ()
Files.writeLines FilePath
fname forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Html -> Text
Html.un_html forall a b. (a -> b) -> a -> b
$
[(Text, Abstraction)] -> Score -> [Html]
render [(Text, Abstraction)]
defaultAbstractions Score
score
data Config = Config {
Config -> Abstraction
_abstraction :: !Format.Abstraction
, Config -> Font
_font :: !Font
, Config -> Int
_rulerEach :: !Int
} deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> FilePath
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)
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
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", 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 :: [(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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GInstrument -> [Html]
htmlInstrument forall a b. (a -> b) -> a -> b
$ Score -> [GInstrument]
Format.scoreInstruments Score
score
htmlInstrument :: GInstrument -> [Html]
htmlInstrument (Korvai.GInstrument Instrument stroke
inst) =
Html
"<h3>" forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
instName forall a. Semigroup a => a -> a -> a
<> Html
"</h3>"
forall a. a -> [a] -> [a]
: [(Text, Abstraction)] -> Text -> Html
chooseAbstraction [(Text, Abstraction)]
abstractions Text
instName
forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (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 = 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 forall a. a -> [a] -> [a]
: [Html]
meta forall a. [a] -> [a] -> [a]
++ [Html]
body 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 forall a. Maybe a
Nothing
forall a. a -> [a] -> [a]
: (case Score
score of
Korvai.Single Korvai
korvai -> Korvai -> [Html]
render Korvai
korvai
Korvai.Tani Metadata
_ [Part Korvai]
parts -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Part Korvai -> [Html]
partHtmls [Part Korvai]
parts)
forall a. [a] -> [a] -> [a]
++ [Html
"</div>"]
where
partHtmls :: Part Korvai -> [Html]
partHtmls (Korvai.Comment Text
cmt) = [Html
"<h3>" forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
cmt forall a. Semigroup a => a -> a -> a
<> Html
"</h3>"]
partHtmls (Korvai.K Korvai
korvai) = Korvai -> [Html]
render Korvai
korvai
render :: Korvai -> [Html]
render = 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)
] forall a. [a] -> [a] -> [a]
++ if Text
aname 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 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 =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Font -> [Html] -> [Html]
scoreTable (Config -> Font
_font Config
config) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [[a]]
Lists.splitBefore forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL forall {stroke}.
Notation stroke =>
PrevRuler
-> (Int, Section (),
Either Text ([Flat Meta (Note stroke)], [Warning]))
-> (PrevRuler, [(Bool, [Html])])
show1 (forall a. Maybe a
Nothing, Int
0) forall a b. (a -> b) -> a -> b
$
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] (Korvai -> [Section ()]
Korvai.genericSections Korvai
korvai) [Either Text ([Flat stroke], [Warning])]
sectionNotes
where
sectionNotes :: [Either Text ([Flat stroke], [Warning])]
sectionNotes = forall stroke warnings.
[Either Text ([Flat stroke], warnings)]
-> [Either Text ([Flat stroke], warnings)]
Format.convertGroups (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 forall a b. (a -> b) -> a -> b
$ Text
"ERROR: " forall a. Semigroup a => a -> a -> a
<> Text
err])
Right ([Flat Meta (Note stroke)]
notes, [Warning]
warnings) -> (PrevRuler
nextRuler,) 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
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Warning -> (Bool, [Html])
showWarning [Warning]
warnings
where
(PrevRuler
nextRuler, [(Maybe Ruler, [(State, Symbol)])]
avartanams) =
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 forall a b. (a -> b) -> a -> b
$ Text
"WARNING: " forall a. Semigroup a => a -> a -> a
<> Text
msg
toSpeed :: Int
toSpeed = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Int
0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall g a. [Flat g a] -> Int
S.maxSpeed (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {a} {b}. Either a (a, b) -> Maybe a
notesOf [Either Text ([Flat stroke], [Warning])]
sectionNotes)
notesOf :: Either a (a, b) -> Maybe a
notesOf (Right (a
notes, b
_)) = forall a. a -> Maybe a
Just a
notes
notesOf Either a (a, b)
_ = forall a. Maybe a
Nothing
msgRow :: Text -> (Bool, [Html.Html])
msgRow :: Text -> (Bool, [Html])
msgRow Text
msg =
(Bool
False, [Html
"<tr><td colspan=100>" forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
msg forall a. Semigroup a => a -> a -> a
<> Html
"</td></tr>"])
scoreTable :: Font -> [Html.Html] -> [Html.Html]
scoreTable :: Font -> [Html] -> [Html]
scoreTable Font
_ [] = []
scoreTable Font
font [Html]
rows = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Html
"\n<p><table style=\"" forall a. Semigroup a => a -> a -> a
<> Html
fontStyle
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: " forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html (forall a. Show a => a -> Text
showt (Font -> Int
_sizePercent Font
font)) forall a. Semigroup a => a -> a -> a
<> 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
Text
title = forall a. Textlike a => a -> [a] -> a
Texts.join Html
"\n"
[ Html
"<html><head>"
, Html
"<meta charset=utf-8>"
, Html
"<title>" forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html Text
title 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> " forall a. Semigroup a => a -> a -> a
<> forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap ((forall a. Semigroup a => a -> a -> a
<>Html
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
radio forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Abstraction)]
abstractions
where
radio :: Text -> Html
radio Text
val = Text -> Html -> Html
Html.tag Text
"label" forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Maybe Html -> Html
Html.tag_attrs Text
"input" (forall {a}. IsString a => Text -> [(a, Text)]
attrs Text
val) (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('" forall a. Semigroup a => a -> a -> a
<> Text
instrument forall a. Semigroup a => a -> a -> a
<> Text
"', this.value)")
, (a
"name", Text
"abstraction-" forall a. Semigroup a => a -> a -> a
<> Text
instrument)
, (a
"value", Text
val)
] forall a. [a] -> [a] -> [a]
++ if Text
val forall a. Eq a => a -> a -> Bool
== Text
defaultAbstraction then [(a
"checked", Text
"")] else []
htmlFooter :: Html.Html
= Html
"</body></html>\n"
allCss :: Html.Html
allCss :: Html
allCss = 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"
_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 forall a b. (a -> b) -> a -> b
$ 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) <- forall a k. (a -> k) -> [a] -> [(k, a)]
Lists.keyOn GroupType -> (RgbColor, RgbColor)
typeColors [GroupType]
Solkattu.groupTypes
]
where
styles :: GroupType -> Text -> Text -> [Text]
styles GroupType
gtype Text
start Text
end =
[ Text
"." forall a. Semigroup a => a -> a -> a
<> GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
Start
forall a. Semigroup a => a -> a -> a
<> Text
" { background: linear-gradient(to right, "
forall a. Semigroup a => a -> a -> a
<> Text
start forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
") }"
, Text
"." forall a. Semigroup a => a -> a -> a
<> GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
In forall a. Semigroup a => a -> a -> a
<> Text
" { background-color: " forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
" }"
, Text
"." forall a. Semigroup a => a -> a -> a
<> GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
End
forall a. Semigroup a => a -> a -> a
<> Text
" { background: linear-gradient(to right, "
forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
", white) }"
]
cssColor :: RgbColor -> Text
cssColor RgbColor
c = Text
"rgb(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map Float -> Text
to8 [Float
r, Float
g, Float
b]) 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 = forall a. Show a => a -> Text
showt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*Float
255)
data Pos = Start | In | End
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 -> FilePath
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)
groupStyle :: Solkattu.GroupType -> Pos -> Text
groupStyle :: GroupType -> Pos -> Text
groupStyle GroupType
gtype Pos
pos = Text
"g" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt GroupType
gtype forall a. Semigroup a => a -> a -> a
<> 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 -> forall {b}. b -> (b, b)
both 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 -> forall {b}. b -> (b, b)
both forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> RgbColor
rgb Float
0.7 Float
0.85 Float
0.7
Solkattu.GCheckDuration {} -> forall {b}. b -> (b, b)
both 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
_sectionMetadata :: Korvai.Section sollu -> Html.Html
_sectionMetadata :: forall sollu. Section sollu -> Html
_sectionMetadata Section sollu
section = forall a. Textlike a => a -> [a] -> a
Texts.join Html
"; " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text, [Text]) -> Html
showTag (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 forall a b. (a -> b) -> a -> b
$ 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 forall a. Semigroup a => a -> a -> a
<> Html
": "
forall a. Semigroup a => a -> a -> a
<> forall a. Textlike a => a -> [a] -> a
Texts.join 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 = forall a. (a -> a) -> [a] -> [a]
Lists.mapInit (forall a. Semigroup a => a -> a -> a
<>Html
"<br>") forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
[ [Html
"Tala: " forall a. Semigroup a => a -> a -> a
<> Text -> Html
Html.html (Text -> [Text] -> Text
Text.intercalate Text
", " (Score -> [Text]
scoreTalas Score
score))]
, [Html
"Date: " 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", forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Text
pretty [Text]
eddupus) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
eddupus)]
, forall a b. (a -> b) -> [a] -> [b]
map (Text, [Text]) -> Html
showTag (forall k a. Map k a -> [(k, a)]
Map.toAscList (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
"tala" Map Text [Text]
tags))
]
where
eddupus :: [Text]
eddupus = forall a. Ord a => [a] -> [a]
Lists.unique forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
"0") forall a b. (a -> b) -> a -> b
$
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 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
Score -> [Tags]
Metadata.sectionTags Score
score
tags :: Map Text [Text]
tags = Tags -> Map Text [Text]
Tags.untags 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 forall a. Semigroup a => a -> a -> a
<> Html
": "
forall a. Semigroup a => a -> a -> a
<> forall a. Textlike a => a -> [a] -> a
Texts.join 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> FilePath
Calendar.showGregorian
scoreTalas :: Korvai.Score -> [Text]
scoreTalas :: Score -> [Text]
scoreTalas = forall a. Ord a => [a] -> [a]
Lists.unique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Tala -> Text
Talas.name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Korvai -> Tala
Korvai.korvaiTala)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Score -> [Korvai]
Korvai.scoreKorvais
formatAvartanams :: Solkattu.Notation stroke => Config -> S.Speed
-> Format.PrevRuler -> Talas.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 =
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall note a.
(note -> Bool)
-> (note -> Bool) -> [[[(a, note)]]] -> [[[(a, note)]]]
Format.formatFinalAvartanam (Html -> Bool
isRest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Html
_html) (forall a b. a -> b -> a
const Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(State, a)] -> [[(State, a)]]
Format.breakAvartanams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall stroke.
Notation stroke =>
NormalizedFlat stroke -> [(State, Symbol)]
makeSymbols
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stroke.
Abstraction -> [NormalizedFlat stroke] -> [NormalizedFlat stroke]
Format.makeGroupsAbstract (Config -> Abstraction
_abstraction Config
config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stroke.
Int -> Int -> [Flat stroke] -> [NormalizedFlat stroke]
Format.normalizeSpeed Int
toSpeed (Tala -> Int
Talas.aksharas 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
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
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
_) = forall a. Pretty a => a -> Text
pretty Html
html
makeSymbols :: Solkattu.Notation stroke => Format.NormalizedFlat stroke
-> [(S.State, Symbol)]
makeSymbols :: forall stroke.
Notation stroke =>
NormalizedFlat stroke -> [(State, Symbol)]
makeSymbols = 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_)) =
(forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ (State
state,) forall a b. (a -> b) -> a -> b
$ Symbol
{ _html :: Html
_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 = forall a. Maybe a
Nothing
}
where note :: Stroke (Note stroke)
note = 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) = forall {a}. [(a, Symbol)] -> [(a, Symbol)]
modify (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
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))]
_ -> forall a. a -> a
id
[Flat Meta (State, Stroke (Note stroke))]
_ -> forall {p :: * -> * -> *} {a}.
Bifunctor p =>
GroupType -> [p a Symbol] -> [p a Symbol]
setStyle GroupType
Solkattu.GSarva
GroupType
gtype -> 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 = forall a. (a -> a) -> [a] -> [a]
Lists.mapLast (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Pos -> Symbol -> Symbol
set Pos
End))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
Lists.mapHeadTail (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Pos -> Symbol -> Symbol
set Pos
Start)) (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 = 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
GroupType
Solkattu.GSarva -> Html
"<hr style=\"border: 4px dotted\">"
GroupType
_ -> Html
"<hr noshade>"
S.Sustain Note stroke
a -> forall {p}. Notation p => State -> p -> Html
notation State
state Note stroke
a
S.Attack Note stroke
a -> forall {p}. Notation p => State -> p -> Html
notation State
state Note stroke
a
Stroke (Note stroke)
S.Rest -> Text -> Html
Html.html Text
"_"
normalizeSarva :: Stroke (Note stroke) -> Stroke (Note stroke)
normalizeSarva (S.Attack n :: Note stroke
n@(Realize.Abstract Meta
meta))
| Meta -> GroupType
Solkattu._type Meta
meta forall a. Eq a => a -> a -> Bool
== GroupType
Solkattu.GSarva = 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) = forall a. Notation a => a -> (Style, Text)
Solkattu.notation p
n
formatTable :: Talas.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 = forall a b. (a -> b) -> [a] -> [b]
map (Bool, (Maybe Ruler, [(State, Symbol)]), Bool) -> (Bool, [Html])
row forall a b. (a -> b) -> a -> b
$ 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 (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>" forall a. Semigroup a => a -> a -> a
<> Ruler -> Html
formatRuler Ruler
ruler forall a. Semigroup a => a -> a -> a
<> Html
"</tr>" forall a. a -> [a] -> [a]
: [Html]
notes
)
Maybe Ruler
Nothing -> (Bool
False, [Html]
notes)
where
notes :: [Html]
notes = (Html
"<tr><td>" forall a. Semigroup a => a -> a -> a
<> Bool -> Html
sectionTags Bool
isFirst forall a. Semigroup a => a -> a -> a
<> Html
"</td>") forall a. a -> [a] -> [a]
: [Html]
cellTds
forall a. [a] -> [a] -> [a]
++ [Html
"</tr>\n"]
cellTds :: [Html]
cellTds = forall a b. (a -> b) -> [a] -> [b]
map ([(Text, Text)], Html) -> Html
td forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b x. ([a] -> [b]) -> [(x, a)] -> [(x, b)]
Format.mapSnd [(Int, Html)] -> [Html]
spellRests
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [(Int, (State, Symbol))] -> ([(Text, Text)], (Int, Html))
mkCell Bool
isFinal) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy forall {a} {a} {a}.
(a, (a, Symbol)) -> (a, (State, Symbol)) -> Bool
merge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] 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%")] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Html
Html.html Text
tags
where tags :: Text
tags = Tags -> Text
Format.showTags (forall a. Section a -> Tags
Korvai.sectionTags Section ()
section)
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)
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
""))
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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [(Text
"class", [Text] -> Text
Text.unwords [Text]
classes) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes)]
, [(Text
"colspan", forall a. Show a => a -> Text
showt Int
cells) | Int
cells forall a. Ord a => a -> a -> Bool
> Int
1]
]
where cells :: Int
cells = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, (State, Symbol))]
syms
classes :: [Text]
classes = 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 -> []
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) (Symbol -> Maybe Text
_style Symbol
sym)
, [Text
"finalLine" | Bool
isFinal]
]
angas :: Set Int
angas = Tala -> Set Int
Talas.angaSet Tala
tala
zipFirstFinal :: [a] -> [(Bool, a, Bool)]
zipFirstFinal :: forall a. [a] -> [(Bool, a, Bool)]
zipFirstFinal =
forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe a
prev, a
x, Maybe a
next) -> (forall a. Maybe a -> Bool
Maybe.isNothing Maybe a
prev, a
x, forall a. Maybe a -> Bool
Maybe.isNothing Maybe a
next))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [(Maybe a, a, Maybe a)]
Lists.zipNeighbors
formatRuler :: Format.Ruler -> Html.Html
formatRuler :: Ruler -> Html
formatRuler =
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (Text, Bool) -> Html
mark forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. Maybe a -> Bool
Maybe.isNothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [(a, Maybe a)]
Lists.zipNext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Int) -> [Text]
akshara
where
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 forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
spacesforall a. Num a => a -> a -> a
-Int
1) Text
""
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 forall a. a -> [a] -> [a]
: [(Int, Html)] -> [Html]
spell [(Int, Html)]
syms
| Just [(Int, Html)]
post <- forall {a}. Int -> [(a, Html)] -> Int -> Maybe [(a, Html)]
checkRests Int
col [(Int, Html)]
syms Int
4 =
(Html
double forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
3 Html
"") forall a. [a] -> [a] -> [a]
++ [(Int, Html)] -> [Html]
spell [(Int, Html)]
post
| Just [(Int, Html)]
post <- forall {a}. Int -> [(a, Html)] -> Int -> Maybe [(a, Html)]
checkRests Int
col [(Int, Html)]
syms Int
2 =
Html
single forall a. a -> [a] -> [a]
: Html
"" forall a. a -> [a] -> [a]
: [(Int, Html)] -> [Html]
spell [(Int, Html)]
post
| Bool
otherwise = 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 forall a. Integral a => a -> a -> a
`mod` Int
n forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, Html)]
rests forall a. Eq a => a -> a -> Bool
== Int
nforall a. Num a => a -> a -> a
-Int
1 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (Int
nforall a. Num a => a -> a -> a
-Int
1) [(a, Html)]
syms
| Bool
otherwise = forall a. Maybe a
Nothing
where
rests :: [(a, Html)]
rests = forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Html -> Bool
isRest forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall a. Eq a => a -> a -> Bool
==Text
"_") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
Html.un_html
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 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 forall a b. (a -> b) -> a -> b
$ Text
"can't parse: " forall a. Semigroup a => a -> a -> a
<> Text
v
Just (Text
url, Maybe (Time, Time)
range) -> Text -> Html
link forall a b. (a -> b) -> a -> b
$ Text
url forall a. Semigroup a => a -> a -> a
<> case Maybe (Time, Time)
range of
Maybe (Time, Time)
Nothing -> Text
""
Just (Time
start, Time
_) -> Text
"#t=" forall a. Semigroup a => a -> a -> a
<> Stack => 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