-- 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 #-}
{-# LANGUAGE GADTs #-}
-- | Convert realized 'S.Flat' output to text for the terminal.
module Solkattu.Format.Terminal (
    renderAll, printInstrument, printKonnakol
    , Config(..), defaultConfig, konnakolConfig
    , formatInstrument
#ifdef TESTING
    , module Solkattu.Format.Terminal
#endif
) where
import qualified Data.Either as Either
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO

import qualified Util.Num as Num
import qualified Util.Seq as Seq
import qualified Util.Styled as Styled

import qualified Solkattu.Format.Format as Format
import qualified Solkattu.Korvai as Korvai
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


type Error = Text

data Config = Config {
    -- | 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
    , Config -> Int
_terminalWidth :: !Int
    -- | Normally 'format' tries to figure out a with for each stroke according
    -- to what will fit on the screen.  But it assumes notation is always at
    -- most one character per time unit.  This hardcodes the width for e.g.
    -- konnakol, where a sollu like `thom` can be 4 characters wide.
    , Config -> Maybe Int
_overrideStrokeWidth :: !(Maybe Int)
    , Config -> Abstraction
_abstraction :: !Format.Abstraction
    } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
    { _rulerEach :: Int
_rulerEach = Int
4
    , _terminalWidth :: Int
_terminalWidth = Int
78
    , _overrideStrokeWidth :: Maybe Int
_overrideStrokeWidth = Maybe Int
forall a. Maybe a
Nothing
    , _abstraction :: Abstraction
_abstraction = Abstraction
Format.defaultAbstraction
    }

konnakolConfig :: Config
konnakolConfig :: Config
konnakolConfig = Config
    { _rulerEach :: Int
_rulerEach = Int
4
    , _terminalWidth :: Int
_terminalWidth = Int
100
    , _overrideStrokeWidth :: Maybe Int
_overrideStrokeWidth = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3
    , _abstraction :: Abstraction
_abstraction = Abstraction
Format.defaultAbstraction
    }

-- * write

-- | Render all instrument realizations.
renderAll :: Format.Abstraction -> Korvai.Score -> [Text]
renderAll :: Abstraction -> Score -> [Text]
renderAll Abstraction
abstraction Score
score = (GInstrument -> [Text]) -> [GInstrument] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GInstrument -> [Text]
write1 ([GInstrument] -> [Text]) -> [GInstrument] -> [Text]
forall a b. (a -> b) -> a -> b
$ Score -> [GInstrument]
Format.scoreInstruments Score
score
    where
    write1 :: GInstrument -> [Text]
write1 (Korvai.GInstrument Instrument stroke
inst) =
        Instrument stroke -> Text
forall stroke. Instrument stroke -> Text
Korvai.instrumentName Instrument stroke
inst Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
        Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text], Bool) -> [Text]
forall a b. (a, b) -> a
fst (Config
-> Instrument stroke
-> (Stroke stroke -> Maybe (Stroke stroke))
-> Score
-> ([Text], Bool)
forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Score
-> ([Text], Bool)
formatScore (Config
config { _abstraction :: Abstraction
_abstraction = Abstraction
abstraction }) Instrument stroke
inst Stroke stroke -> Maybe (Stroke stroke)
forall a. a -> Maybe a
Just
            Score
score)
        where
        config :: Config
config = case Instrument stroke
inst of
            Instrument stroke
Korvai.IKonnakol -> Config
konnakolConfig
            Instrument stroke
_ -> Config
defaultConfig

-- * format

printInstrument :: (Solkattu.Notation stroke, Ord stroke)
    => Korvai.Instrument stroke -> Format.Abstraction -> Korvai.Korvai
    -> IO ()
printInstrument :: forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Abstraction -> Korvai -> IO ()
printInstrument Instrument stroke
instrument Abstraction
abstraction =
    (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
Text.IO.putStrLn ([Text] -> IO ()) -> (Korvai -> [Text]) -> Korvai -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], Bool) -> [Text]
forall a b. (a, b) -> a
fst
    (([Text], Bool) -> [Text])
-> (Korvai -> ([Text], Bool)) -> Korvai -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config
-> Instrument stroke
-> (Stroke stroke -> Maybe (Stroke stroke))
-> Korvai
-> ([Text], Bool)
forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> ([Text], Bool)
formatInstrument (Config
defaultConfig { _abstraction :: Abstraction
_abstraction = Abstraction
abstraction }) Instrument stroke
instrument
        Stroke stroke -> Maybe (Stroke stroke)
forall a. a -> Maybe a
Just

printKonnakol :: Config -> Korvai.Korvai -> IO ()
printKonnakol :: Config -> Korvai -> IO ()
printKonnakol Config
config =
    (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
Text.IO.putStrLn ([Text] -> IO ()) -> (Korvai -> [Text]) -> Korvai -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], Bool) -> [Text]
forall a b. (a, b) -> a
fst (([Text], Bool) -> [Text])
-> (Korvai -> ([Text], Bool)) -> Korvai -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config
-> Instrument Sollu
-> (Stroke Sollu -> Maybe (Stroke Sollu))
-> Korvai
-> ([Text], Bool)
forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> ([Text], Bool)
formatInstrument Config
config Instrument Sollu
Korvai.IKonnakol Stroke Sollu -> Maybe (Stroke Sollu)
forall a. a -> Maybe a
Just

formatScore
    :: (Solkattu.Notation stroke1, Solkattu.Notation stroke2, Ord stroke1)
    => Config
    -> Korvai.Instrument stroke1
    -> (Realize.Stroke stroke1 -> Maybe (Realize.Stroke stroke2))
    -> Korvai.Score -> ([Text], Bool)
    -- ^ (lines, hadError)
formatScore :: forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Score
-> ([Text], Bool)
formatScore Config
config Instrument stroke1
instrument Stroke stroke1 -> Maybe (Stroke stroke2)
postproc = \case
    Korvai.Single Korvai
korvai -> Korvai -> ([Text], Bool)
formatK Korvai
korvai
    Korvai.Tani Metadata
_ [Part Korvai]
parts -> ([[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]]
lines, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
errors)
        where ([[Text]]
lines, [Bool]
errors) = [([Text], Bool)] -> ([[Text]], [Bool])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Text], Bool)] -> ([[Text]], [Bool]))
-> [([Text], Bool)] -> ([[Text]], [Bool])
forall a b. (a -> b) -> a -> b
$ (Part Korvai -> ([Text], Bool))
-> [Part Korvai] -> [([Text], Bool)]
forall a b. (a -> b) -> [a] -> [b]
map Part Korvai -> ([Text], Bool)
format [Part Korvai]
parts
    where
    format :: Part Korvai -> ([Text], Bool)
format (Korvai.Comment Text
cmt) = ([Text
cmt], Bool
False)
    format (Korvai.K Korvai
korvai) = Korvai -> ([Text], Bool)
formatK Korvai
korvai
    formatK :: Korvai -> ([Text], Bool)
formatK = Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> ([Text], Bool)
forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> ([Text], Bool)
formatInstrument Config
config Instrument stroke1
instrument Stroke stroke1 -> Maybe (Stroke stroke2)
postproc

formatInstrument
    :: (Solkattu.Notation stroke1, Solkattu.Notation stroke2, Ord stroke1)
    => Config
    -> Korvai.Instrument stroke1
    -> (Realize.Stroke stroke1 -> Maybe (Realize.Stroke stroke2))
    -> Korvai.Korvai -> ([Text], Bool)
    -- ^ (lines, hadError)
formatInstrument :: forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> ([Text], Bool)
formatInstrument Config
config Instrument stroke1
instrument Stroke stroke1 -> Maybe (Stroke stroke2)
postproc Korvai
korvai =
    Config
-> Tala
-> [(Tags, Either Text ([Flat stroke2], [Warning]))]
-> ([Text], Bool)
forall stroke.
Notation stroke =>
Config
-> Tala
-> [(Tags, Either Text ([Flat stroke], [Warning]))]
-> ([Text], Bool)
formatResults Config
config (Korvai -> Tala
Korvai.korvaiTala Korvai
korvai) ([(Tags, Either Text ([Flat stroke2], [Warning]))]
 -> ([Text], Bool))
-> [(Tags, Either Text ([Flat stroke2], [Warning]))]
-> ([Text], Bool)
forall a b. (a -> b) -> a -> b
$ [Tags]
-> [Either Text ([Flat stroke2], [Warning])]
-> [(Tags, Either Text ([Flat stroke2], [Warning]))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Korvai -> [Tags]
korvaiTags Korvai
korvai) ([Either Text ([Flat stroke2], [Warning])]
 -> [(Tags, Either Text ([Flat stroke2], [Warning]))])
-> [Either Text ([Flat stroke2], [Warning])]
-> [(Tags, Either Text ([Flat stroke2], [Warning]))]
forall a b. (a -> b) -> a -> b
$
        (Either Text ([Flat Meta (Note stroke1)], [Warning])
 -> Either Text ([Flat stroke2], [Warning]))
-> [Either Text ([Flat Meta (Note stroke1)], [Warning])]
-> [Either Text ([Flat stroke2], [Warning])]
forall a b. (a -> b) -> [a] -> [b]
map ((([Flat Meta (Note stroke1)], [Warning])
 -> ([Flat stroke2], [Warning]))
-> Either Text ([Flat Meta (Note stroke1)], [Warning])
-> Either Text ([Flat stroke2], [Warning])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Flat Meta (Note stroke1)] -> [Flat stroke2])
-> ([Flat Meta (Note stroke1)], [Warning])
-> ([Flat stroke2], [Warning])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Stroke stroke1 -> Maybe (Stroke stroke2))
-> [Flat Meta (Note stroke1)] -> [Flat stroke2]
forall a b g.
(Stroke a -> Maybe (Stroke b))
-> [Flat g (Note a)] -> [Flat g (Note b)]
Korvai.mapStrokeRest Stroke stroke1 -> Maybe (Stroke stroke2)
postproc))) ([Either Text ([Flat Meta (Note stroke1)], [Warning])]
 -> [Either Text ([Flat stroke2], [Warning])])
-> [Either Text ([Flat Meta (Note stroke1)], [Warning])]
-> [Either Text ([Flat stroke2], [Warning])]
forall a b. (a -> b) -> a -> b
$
        [Either Text ([Flat stroke1], [Warning])]
-> [Either Text ([Flat Meta (Note stroke1)], [Warning])]
forall stroke warnings.
[Either Text ([Flat stroke], warnings)]
-> [Either Text ([Flat stroke], warnings)]
Format.convertGroups ([Either Text ([Flat stroke1], [Warning])]
 -> [Either Text ([Flat Meta (Note stroke1)], [Warning])])
-> [Either Text ([Flat stroke1], [Warning])]
-> [Either Text ([Flat Meta (Note stroke1)], [Warning])]
forall a b. (a -> b) -> a -> b
$
        Instrument stroke1
-> Korvai -> [Either Text ([Flat stroke1], [Warning])]
forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Korvai -> [Either Text (Realized stroke)]
Korvai.realize Instrument stroke1
instrument Korvai
korvai

korvaiTags :: Korvai.Korvai -> [Tags.Tags]
korvaiTags :: Korvai -> [Tags]
korvaiTags = (Section () -> Tags) -> [Section ()] -> [Tags]
forall a b. (a -> b) -> [a] -> [b]
map Section () -> Tags
forall a. Section a -> Tags
Korvai.sectionTags ([Section ()] -> [Tags])
-> (Korvai -> [Section ()]) -> Korvai -> [Tags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Korvai -> [Section ()]
Korvai.genericSections

formatResults :: Solkattu.Notation stroke => Config -> Tala.Tala
    -> [ ( Tags.Tags
         , Either Error ([Format.Flat stroke], [Realize.Warning])
         )
       ]
    -> ([Text], Bool)
formatResults :: forall stroke.
Notation stroke =>
Config
-> Tala
-> [(Tags, Either Text ([Flat stroke], [Warning]))]
-> ([Text], Bool)
formatResults Config
config Tala
tala [(Tags, Either Text ([Flat stroke], [Warning]))]
results =
    ( [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> ([(Tags, Either Text ([Flat stroke], [Warning]))] -> [[Text]])
-> [(Tags, Either Text ([Flat stroke], [Warning]))]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrevRuler, [[Text]]) -> [[Text]]
forall a b. (a, b) -> b
snd ((PrevRuler, [[Text]]) -> [[Text]])
-> ([(Tags, Either Text ([Flat stroke], [Warning]))]
    -> (PrevRuler, [[Text]]))
-> [(Tags, Either Text ([Flat stroke], [Warning]))]
-> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrevRuler
 -> (Integer, (Tags, Either Text ([Flat stroke], [Warning])))
 -> (PrevRuler, [Text]))
-> PrevRuler
-> [(Integer, (Tags, Either Text ([Flat stroke], [Warning])))]
-> (PrevRuler, [[Text]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL PrevRuler
-> (Integer, (Tags, Either Text ([Flat stroke], [Warning])))
-> (PrevRuler, [Text])
show1 (Maybe Ruler
forall a. Maybe a
Nothing, Int
0) ([(Integer, (Tags, Either Text ([Flat stroke], [Warning])))]
 -> (PrevRuler, [[Text]]))
-> ([(Tags, Either Text ([Flat stroke], [Warning]))]
    -> [(Integer, (Tags, Either Text ([Flat stroke], [Warning])))])
-> [(Tags, Either Text ([Flat stroke], [Warning]))]
-> (PrevRuler, [[Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer]
-> [(Tags, Either Text ([Flat stroke], [Warning]))]
-> [(Integer, (Tags, Either Text ([Flat stroke], [Warning])))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([(Tags, Either Text ([Flat stroke], [Warning]))] -> [Text])
-> [(Tags, Either Text ([Flat stroke], [Warning]))] -> [Text]
forall a b. (a -> b) -> a -> b
$ [(Tags, Either Text ([Flat stroke], [Warning]))]
results
    , ((Tags, Either Text ([Flat stroke], [Warning])) -> Bool)
-> [(Tags, Either Text ([Flat stroke], [Warning]))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Either Text ([Flat stroke], [Warning]) -> Bool
forall a b. Either a b -> Bool
Either.isLeft (Either Text ([Flat stroke], [Warning]) -> Bool)
-> ((Tags, Either Text ([Flat stroke], [Warning]))
    -> Either Text ([Flat stroke], [Warning]))
-> (Tags, Either Text ([Flat stroke], [Warning]))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tags, Either Text ([Flat stroke], [Warning]))
-> Either Text ([Flat stroke], [Warning])
forall a b. (a, b) -> b
snd) [(Tags, Either Text ([Flat stroke], [Warning]))]
results
    )
    where
    show1 :: PrevRuler
-> (Integer, (Tags, Either Text ([Flat stroke], [Warning])))
-> (PrevRuler, [Text])
show1 PrevRuler
_ (Integer
_section, (Tags
_, Left Text
err)) =
        ((Maybe Ruler
forall a. Maybe a
Nothing, Int
0), [Int -> Text -> Text
Text.replicate Int
leader Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ERROR:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err])
    show1 PrevRuler
prevRuler (Integer
section, (Tags
tags, Right ([Flat stroke]
notes, [Warning]
warnings))) =
        ( PrevRuler
nextRuler
        -- Use an empty section with commentS to describe what to play.
        , if [Flat stroke] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Flat stroke]
notes then (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Bool -> Integer -> Text
sectionNumber Bool
False Integer
section
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> ([Text] -> Text) -> Maybe [Text] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"empty" [Text] -> Text
Text.unwords
                    (Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
Tags.comment (Tags -> Map Text [Text]
Tags.untags Tags
tags))
            else Integer -> Tags -> [(LineType, Styled)] -> [Text]
sectionFmt Integer
section Tags
tags [(LineType, Styled)]
lines
                [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Warning -> Text) -> [Warning] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Warning -> Text
showWarning Int
strokeWidth) [Warning]
warnings
        )
        where
        (Int
strokeWidth, (PrevRuler
nextRuler, [(LineType, Styled)]
lines)) = Config
-> PrevRuler
-> Tala
-> [Flat stroke]
-> (Int, (PrevRuler, [(LineType, Styled)]))
forall stroke.
Notation stroke =>
Config
-> PrevRuler
-> Tala
-> [Flat stroke]
-> (Int, (PrevRuler, [(LineType, Styled)]))
format Config
config PrevRuler
prevRuler Tala
tala [Flat stroke]
notes
    showWarning :: Int -> Warning -> Text
showWarning Int
_ (Realize.Warning Maybe Int
Nothing Text
msg) = Text
msg
    showWarning Int
strokeWidth (Realize.Warning (Just Int
i) Text
msg) =
        Int -> Text -> Text
Text.replicate (Int
leader Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
strokeWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
        -- TODO the ^ only lines up if there is only one line.  Otherwise
        -- I have to divMod i by strokes per line, and use that to insert
        -- in the formatted output
    -- If I want to normalize speed across all sections, then this is the place
    -- to get it.  I originally tried this, but from looking at the results I
    -- think I like when the notation can get more compact.
    -- toSpeed = maximum $ 0 : map S.maxSpeed (mapMaybe notesOf results)
    -- notesOf (_, Right (notes, _)) = Just notes
    -- notesOf _ = Nothing
    sectionFmt :: Integer -> Tags -> [(LineType, Styled)] -> [Text]
sectionFmt Integer
section Tags
tags =
        (if Text -> Bool
Text.null Text
tagsText then [Text] -> [Text]
forall a. a -> a
id
            else (Text -> Text) -> [Text] -> [Text]
forall a. (a -> a) -> [a] -> [a]
Seq.map_last (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"   " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tagsText))
        ([Text] -> [Text])
-> ([(LineType, Styled)] -> [Text])
-> [(LineType, Styled)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, [Text]) -> [Text]
forall a b. (a, b) -> b
snd ((Bool, [Text]) -> [Text])
-> ([(LineType, Styled)] -> (Bool, [Text]))
-> [(LineType, Styled)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> (LineType, Text) -> (Bool, Text))
-> Bool -> [(LineType, Text)] -> (Bool, [Text])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (Tags -> Integer -> Bool -> (LineType, Text) -> (Bool, Text)
addHeader Tags
tags Integer
section) Bool
False
        ([(LineType, Text)] -> (Bool, [Text]))
-> ([(LineType, Styled)] -> [(LineType, Text)])
-> [(LineType, Styled)]
-> (Bool, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LineType, Styled) -> (LineType, Text))
-> [(LineType, Styled)] -> [(LineType, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Styled -> Text) -> (LineType, Styled) -> (LineType, Text)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text -> Text
Text.strip (Text -> Text) -> (Styled -> Text) -> Styled -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Styled -> Text
Styled.toText))
        where
        -- tagsText = showt tags
        tagsText :: Text
tagsText = Tags -> Text
Format.showTags Tags
tags
    addHeader :: Tags -> Integer -> Bool -> (LineType, Text) -> (Bool, Text)
addHeader Tags
tags Integer
section Bool
showedNumber (LineType
AvartanamStart, Text
line) =
        ( Bool
True
        , (if Bool -> Bool
not Bool
showedNumber then Bool -> Integer -> Text
sectionNumber (Tags -> Bool
isEnding Tags
tags) Integer
section
            else Int -> Char -> Text -> Text
Text.justifyRight Int
leader Char
' ' Text
"> ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line
        )
    addHeader Tags
_ Integer
_ Bool
showedNumber (LineType
_, Text
line) =
        (Bool
showedNumber, Int -> Text -> Text
Text.replicate Int
leader Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line)
    sectionNumber :: Bool -> Integer -> Text
sectionNumber Bool
isEnding Integer
section = Styled -> Text
Styled.toText (Styled -> Text) -> Styled -> Text
forall a b. (a -> b) -> a -> b
$
        Color -> Text -> Styled
forall a. ToStyled a => Color -> a -> Styled
Styled.bg (Color -> Color
Styled.bright Color
color) (Text -> Styled) -> Text -> Styled
forall a b. (a -> b) -> a -> b
$
        Int -> Char -> Text -> Text
Text.justifyLeft Int
leader Char
' ' (Integer -> Text
forall a. Show a => a -> Text
showt Integer
section Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
        where
        -- Highlight endings specially, seems to be a useful landmark.
        color :: Color
color = if Bool
isEnding then Color
Styled.cyan else Color
Styled.yellow
    leader :: Int
leader = Int
4
    isEnding :: Tags -> Bool
isEnding = (Maybe [Text] -> Maybe [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
Tags.ending]) (Maybe [Text] -> Bool) -> (Tags -> Maybe [Text]) -> Tags -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
Tags.type_ (Map Text [Text] -> Maybe [Text])
-> (Tags -> Map Text [Text]) -> Tags -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tags -> Map Text [Text]
Tags.untags


-- * implementation

-- | Keep state about the last ruler across calls to 'format', so I can
-- suppress unneeded ones.  (prevRuler, lineNumber)
type PrevRuler = (Maybe Format.Ruler, Int)

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

data LineType = Ruler | AvartanamStart | AvartanamContinue
    deriving (LineType -> LineType -> Bool
(LineType -> LineType -> Bool)
-> (LineType -> LineType -> Bool) -> Eq LineType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineType -> LineType -> Bool
$c/= :: LineType -> LineType -> Bool
== :: LineType -> LineType -> Bool
$c== :: LineType -> LineType -> Bool
Eq, Int -> LineType -> ShowS
[LineType] -> ShowS
LineType -> String
(Int -> LineType -> ShowS)
-> (LineType -> String) -> ([LineType] -> ShowS) -> Show LineType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineType] -> ShowS
$cshowList :: [LineType] -> ShowS
show :: LineType -> String
$cshow :: LineType -> String
showsPrec :: Int -> LineType -> ShowS
$cshowsPrec :: Int -> LineType -> ShowS
Show)

-- | Format the notes according to the tala.
--
-- The line breaking for rulers is a bit weird in that if the line is broken,
-- I only emit the first part of the ruler.  Otherwise I'd have to have
-- a multiple line ruler too, which might be too much clutter.  I'll have to
-- see how it works out in practice.
format :: Solkattu.Notation stroke => Config -> PrevRuler -> Tala.Tala
    -> [Format.Flat stroke] -> (Int, (PrevRuler, [(LineType, Styled.Styled)]))
format :: forall stroke.
Notation stroke =>
Config
-> PrevRuler
-> Tala
-> [Flat stroke]
-> (Int, (PrevRuler, [(LineType, Styled)]))
format Config
config PrevRuler
prevRuler Tala
tala [Flat stroke]
notes =
    (Int
strokeWidth,) ((PrevRuler, [(LineType, Styled)])
 -> (Int, (PrevRuler, [(LineType, Styled)])))
-> (PrevRuler, [(LineType, Styled)])
-> (Int, (PrevRuler, [(LineType, Styled)]))
forall a b. (a -> b) -> a -> b
$
    ([[(Maybe Ruler, [(State, Symbol)])]] -> [(LineType, Styled)])
-> (PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]])
-> (PrevRuler, [(LineType, Styled)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([(Maybe Ruler, [(State, Symbol)])] -> [(LineType, Styled)])
-> [[(Maybe Ruler, [(State, Symbol)])]] -> [(LineType, Styled)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [(Maybe Ruler, [(State, Symbol)])] -> [(LineType, Styled)]
formatAvartanam) ((PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]])
 -> (PrevRuler, [(LineType, Styled)]))
-> (PrevRuler, [[(Maybe Ruler, [(State, Symbol)])]])
-> (PrevRuler, [(LineType, Styled)])
forall a b. (a -> b) -> a -> b
$
    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
strokeWidth
        [[[(State, Symbol)]]]
avartanamLines
    where
    formatAvartanam :: [(Maybe Ruler, [(State, Symbol)])] -> [(LineType, Styled)]
formatAvartanam = ((Maybe Ruler, [(State, Symbol)]) -> [(LineType, Styled)])
-> [(Maybe Ruler, [(State, Symbol)])] -> [(LineType, Styled)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Ruler, [(State, Symbol)]) -> [(LineType, Styled)]
formatRulerLine
    formatRulerLine :: (Maybe Ruler, [(State, Symbol)]) -> [(LineType, Styled)]
formatRulerLine (Maybe Ruler
mbRuler, [(State, Symbol)]
line) = [[(LineType, Styled)]] -> [(LineType, Styled)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ case Maybe Ruler
mbRuler of
            Maybe Ruler
Nothing -> []
            Just Ruler
ruler -> [(LineType
Ruler, Int -> Ruler -> Styled
formatRuler Int
strokeWidth Ruler
ruler)]
        , [(if Bool
isFirst then LineType
AvartanamStart else LineType
AvartanamContinue,
            [Symbol] -> Styled
formatLine (((State, Symbol) -> Symbol) -> [(State, Symbol)] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (State, Symbol) -> Symbol
forall a b. (a, b) -> b
snd [(State, Symbol)]
line))]
        ]
        where
        isFirst :: Bool
isFirst = Bool -> ((State, Symbol) -> Bool) -> Maybe (State, Symbol) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Duration -> Duration -> Bool
forall a. Eq a => a -> a -> Bool
==Duration
0) (Duration -> Bool)
-> ((State, Symbol) -> Duration) -> (State, Symbol) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Duration
S.stateMatraPosition (State -> Duration)
-> ((State, Symbol) -> State) -> (State, Symbol) -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State, Symbol) -> State
forall a b. (a, b) -> a
fst)
            ([(State, Symbol)] -> Maybe (State, Symbol)
forall a. [a] -> Maybe a
Seq.head [(State, Symbol)]
line)

    avartanamLines :: [[Line]] -- [avartanam] [[line]] [[[sym]]]
    ([[[(State, Symbol)]]]
avartanamLines, Int
strokeWidth) = case Config -> Maybe Int
_overrideStrokeWidth Config
config of
        Just Int
n -> (Int -> Int -> Tala -> [Flat stroke] -> [[[(State, Symbol)]]]
fmt Int
n Int
width Tala
tala [Flat stroke]
notes, Int
n)
        Maybe Int
Nothing -> case Int -> Int -> Tala -> [Flat stroke] -> [[[(State, Symbol)]]]
fmt Int
1 Int
width Tala
tala [Flat stroke]
notes of
            [[(State, Symbol)]
line] : [[[(State, Symbol)]]]
_ | [(State, Symbol)] -> Int
lineWidth [(State, Symbol)]
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
width Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 ->
                (Int -> Int -> Tala -> [Flat stroke] -> [[[(State, Symbol)]]]
fmt Int
2 Int
width Tala
tala [Flat stroke]
notes, Int
2)
            [[[(State, Symbol)]]]
result -> ([[[(State, Symbol)]]]
result, Int
1)
        where fmt :: Int -> Int -> Tala -> [Flat stroke] -> [[[(State, Symbol)]]]
fmt = Abstraction
-> Int -> Int -> Tala -> [Flat stroke] -> [[[(State, Symbol)]]]
forall stroke.
Notation stroke =>
Abstraction
-> Int -> Int -> Tala -> [Flat stroke] -> [[[(State, Symbol)]]]
formatLines (Config -> Abstraction
_abstraction Config
config)
    formatLine :: [Symbol] -> Styled.Styled
    formatLine :: [Symbol] -> Styled
formatLine = [Styled] -> Styled
forall a. Monoid a => [a] -> a
mconcat ([Styled] -> Styled)
-> ([Symbol] -> [Styled]) -> [Symbol] -> Styled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Styled) -> [Symbol] -> [Styled]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Styled
formatSymbol
    width :: Int
width = Config -> Int
_terminalWidth Config
config

lineWidth :: Line -> Int
lineWidth :: [(State, Symbol)] -> Int
lineWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int)
-> ([(State, Symbol)] -> [Int]) -> [(State, Symbol)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State, Symbol) -> Int) -> [(State, Symbol)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol -> Int
symLength (Symbol -> Int)
-> ((State, Symbol) -> Symbol) -> (State, Symbol) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State, Symbol) -> Symbol
forall a b. (a, b) -> b
snd)

formatRuler :: Int -> Format.Ruler -> Styled.Styled
formatRuler :: Int -> Ruler -> Styled
formatRuler Int
strokeWidth =
    Color -> Text -> Styled
forall a. ToStyled a => Color -> a -> Styled
Styled.bg (Color -> Color
Styled.bright Color
Styled.white)
        (Text -> Styled) -> (Ruler -> Text) -> Ruler -> Styled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Ruler -> [Text]) -> Ruler -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Text]) -> [Text]
forall a b. (a, b) -> b
snd ((Int, [Text]) -> [Text])
-> (Ruler -> (Int, [Text])) -> Ruler -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Text, Int) -> (Int, Text))
-> Int -> Ruler -> (Int, [Text])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL Int -> (Text, Int) -> (Int, Text)
render Int
0
    where
    render :: Int -> (Text, Int) -> (Int, Text)
render Int
debt (Text
mark, Int
spaces) =
        ( Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (-Int
append) -- debt is how many spaces I'm behind
        , Text
mark Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
append Text
" "
        )
        where
        append :: Int
append = Int
spaces Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
strokeWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
mark Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
debt

-- | Replace two rests starting on an even note, with a Realize.doubleRest.
-- This is an elementary form of rhythmic spelling.
--
-- But if strokeWidth=1, then replace replace odd _ with ' ', to avoid clutter.
spellRests :: Int -> [Symbol] -> [Symbol]
spellRests :: Int -> [Symbol] -> [Symbol]
spellRests Int
strokeWidth
    | Int
strokeWidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = ((Integer, Symbol) -> Symbol) -> [(Integer, Symbol)] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Symbol) -> Symbol
forall {a}. Integral a => (a, Symbol) -> Symbol
thin ([(Integer, Symbol)] -> [Symbol])
-> ([Symbol] -> [(Integer, Symbol)]) -> [Symbol] -> [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Symbol] -> [(Integer, Symbol)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..]
    | Bool
otherwise = ((Integer, (Maybe Symbol, Symbol, Maybe Symbol)) -> Symbol)
-> [(Integer, (Maybe Symbol, Symbol, Maybe Symbol))] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, (Maybe Symbol, Symbol, Maybe Symbol)) -> Symbol
forall {a}.
Integral a =>
(a, (Maybe Symbol, Symbol, Maybe Symbol)) -> Symbol
set ([(Integer, (Maybe Symbol, Symbol, Maybe Symbol))] -> [Symbol])
-> ([Symbol] -> [(Integer, (Maybe Symbol, Symbol, Maybe Symbol))])
-> [Symbol]
-> [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer]
-> [(Maybe Symbol, Symbol, Maybe Symbol)]
-> [(Integer, (Maybe Symbol, Symbol, Maybe Symbol))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([(Maybe Symbol, Symbol, Maybe Symbol)]
 -> [(Integer, (Maybe Symbol, Symbol, Maybe Symbol))])
-> ([Symbol] -> [(Maybe Symbol, Symbol, Maybe Symbol)])
-> [Symbol]
-> [(Integer, (Maybe Symbol, Symbol, Maybe Symbol))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> [(Maybe Symbol, Symbol, Maybe Symbol)]
forall a. [a] -> [(Maybe a, a, Maybe a)]
Seq.zip_neighbors
    where
    thin :: (a, Symbol) -> Symbol
thin (a
col, Symbol
sym)
        | Symbol -> Bool
isRest Symbol
sym Bool -> Bool -> Bool
&& a -> Bool
forall a. Integral a => a -> Bool
odd a
col = Symbol
sym { _text :: Text
_text = Text
" " }
        | Bool
otherwise = Symbol
sym
    set :: (a, (Maybe Symbol, Symbol, Maybe Symbol)) -> Symbol
set (a
col, (Maybe Symbol
prev, Symbol
sym, Maybe Symbol
next))
        | Bool -> Bool
not (Symbol -> Bool
isRest Symbol
sym) = Symbol
sym
        | a -> Bool
forall a. Integral a => a -> Bool
even a
col Bool -> Bool -> Bool
&& Bool -> (Symbol -> Bool) -> Maybe Symbol -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Symbol -> Bool
isRest Maybe Symbol
next = Symbol
sym
            { _text :: Text
_text = Int -> Char -> Text -> Text
Realize.justifyLeft (Symbol -> Int
symLength Symbol
sym) Char
' ' Text
double }
        | a -> Bool
forall a. Integral a => a -> Bool
odd a
col Bool -> Bool -> Bool
&& Bool -> (Symbol -> Bool) -> Maybe Symbol -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Symbol -> Bool
isRest Maybe Symbol
prev = Symbol
sym
            { _text :: Text
_text = Int -> Text -> Text
Text.replicate (Symbol -> Int
symLength Symbol
sym) Text
" " }
        | Bool
otherwise = Symbol
sym
    double :: Text
double = Char -> Text
Text.singleton Char
Realize.doubleRest

-- This should be (== Space Rest), but I have to 'makeSymbols' first to break
-- lines.
isRest :: Symbol -> Bool
isRest :: Symbol -> Bool
isRest = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"_") (Text -> Bool) -> (Symbol -> Text) -> Symbol -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip (Text -> Text) -> (Symbol -> Text) -> Symbol -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Text
_text

-- | Break into [avartanam], where avartanam = [line].
formatLines :: Solkattu.Notation stroke => Format.Abstraction -> Int
    -> Int -> Tala.Tala -> [Format.Flat stroke] -> [[[(S.State, Symbol)]]]
formatLines :: forall stroke.
Notation stroke =>
Abstraction
-> Int -> Int -> Tala -> [Flat stroke] -> [[[(State, Symbol)]]]
formatLines Abstraction
abstraction Int
strokeWidth Int
width Tala
tala [Flat stroke]
notes =
    ([[(State, Symbol)]] -> [[(State, Symbol)]])
-> [[[(State, Symbol)]]] -> [[[(State, Symbol)]]]
forall a b. (a -> b) -> [a] -> [b]
map (([(State, Symbol)] -> [(State, Symbol)])
-> [[(State, Symbol)]] -> [[(State, Symbol)]]
forall a b. (a -> b) -> [a] -> [b]
map (([Symbol] -> [Symbol]) -> [(State, Symbol)] -> [(State, Symbol)]
forall a b x. ([a] -> [b]) -> [(x, a)] -> [(x, b)]
Format.mapSnd (Int -> [Symbol] -> [Symbol]
spellRests Int
strokeWidth)))
        ([[[(State, Symbol)]]] -> [[[(State, Symbol)]]])
-> ([Flat stroke] -> [[[(State, Symbol)]]])
-> [Flat stroke]
-> [[[(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 Symbol -> Bool
isRest
        ([[[(State, Symbol)]]] -> [[[(State, Symbol)]]])
-> ([Flat stroke] -> [[[(State, Symbol)]]])
-> [Flat 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 (Int -> [(State, Symbol)] -> [[(State, Symbol)]]
breakLine Int
width)
        ([[(State, Symbol)]] -> [[[(State, Symbol)]]])
-> ([Flat stroke] -> [[(State, Symbol)]])
-> [Flat 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 stroke] -> [(State, Symbol)])
-> [Flat stroke]
-> [[(State, Symbol)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(State, Symbol)] -> [(State, Symbol)]
forall a. Int -> [(a, Symbol)] -> [(a, Symbol)]
overlapSymbols Int
strokeWidth
        ([(State, Symbol)] -> [(State, Symbol)])
-> ([Flat stroke] -> [(State, Symbol)])
-> [Flat 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 (Int
-> Tala -> Set Int -> NormalizedFlat stroke -> [(State, Symbol)]
forall stroke.
Notation stroke =>
Int
-> Tala -> Set Int -> NormalizedFlat stroke -> [(State, Symbol)]
makeSymbols Int
strokeWidth Tala
tala Set Int
angas)
        ([NormalizedFlat stroke] -> [(State, Symbol)])
-> ([Flat stroke] -> [NormalizedFlat stroke])
-> [Flat 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 Abstraction
abstraction
        ([NormalizedFlat stroke] -> [NormalizedFlat stroke])
-> ([Flat stroke] -> [NormalizedFlat stroke])
-> [Flat stroke]
-> [NormalizedFlat stroke]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tala -> [Flat stroke] -> [NormalizedFlat stroke]
forall stroke.
Int -> Tala -> [Flat stroke] -> [NormalizedFlat stroke]
Format.normalizeSpeed Int
toSpeed Tala
tala
        ([Flat stroke] -> [[[(State, Symbol)]]])
-> [Flat stroke] -> [[[(State, Symbol)]]]
forall a b. (a -> b) -> a -> b
$ [Flat stroke]
notes
    where
    angas :: Set Int
angas = Tala -> Set Int
Format.angaSet Tala
tala
    toSpeed :: Int
toSpeed = [Flat stroke] -> Int
forall g a. [Flat g a] -> Int
S.maxSpeed [Flat stroke]
notes

-- | Long names will overlap following _isSustain ones.
overlapSymbols :: Int -> [(a, Symbol)] -> [(a, Symbol)]
overlapSymbols :: forall a. Int -> [(a, Symbol)] -> [(a, Symbol)]
overlapSymbols Int
strokeWidth = ((Text, Maybe Symbol), [(a, Symbol)]) -> [(a, Symbol)]
forall a b. (a, b) -> b
snd (((Text, Maybe Symbol), [(a, Symbol)]) -> [(a, Symbol)])
-> ([(a, Symbol)] -> ((Text, Maybe Symbol), [(a, Symbol)]))
-> [(a, Symbol)]
-> [(a, Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Maybe Symbol) -> Symbol -> ((Text, Maybe Symbol), Symbol))
-> (Text, Maybe Symbol)
-> [(a, Symbol)]
-> ((Text, Maybe Symbol), [(a, Symbol)])
forall state a b x.
(state -> a -> (state, b))
-> state -> [(x, a)] -> (state, [(x, b)])
mapAccumLSnd (Text, Maybe Symbol) -> Symbol -> ((Text, Maybe Symbol), Symbol)
combine (Text
"", Maybe Symbol
forall a. Maybe a
Nothing)
    where
    combine :: (Text, Maybe Symbol) -> Symbol -> ((Text, Maybe Symbol), Symbol)
combine (Text
overlap, Maybe Symbol
overlapSym) Symbol
sym
        | Symbol -> Bool
_isSustain Symbol
sym = if Text -> Bool
Text.null Text
overlap
            then ((Text
"", Maybe Symbol
forall a. Maybe a
Nothing), Symbol
sym)
            else let (Text
pre, Text
post) = Int -> Text -> (Text, Text)
textSplitAt Int
strokeWidth Text
overlap
                in ((Text
post, Maybe Symbol
overlapSym), Text -> Maybe Symbol -> Symbol -> Symbol
replace Text
pre Maybe Symbol
overlapSym Symbol
sym)
        | Bool
otherwise =
            let (Text
pre, Text
post) = Int -> Text -> (Text, Text)
textSplitAt Int
strokeWidth (Symbol -> Text
_text Symbol
sym)
            in ((Text
post, Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
sym), Symbol
sym { _text :: Text
_text = Text
pre })
    replace :: Text -> Maybe Symbol -> Symbol -> Symbol
replace Text
prefix Maybe Symbol
mbOverlapSym Symbol
sym = case Maybe Symbol
mbOverlapSym of
        Maybe Symbol
Nothing -> Symbol
sym { _text :: Text
_text = Text
newText }
        Just Symbol
overlapSym -> Symbol
sym
            { _text :: Text
_text = Text
newText
            , _highlight :: Maybe (Highlight, Color)
_highlight = Symbol -> Maybe (Highlight, Color)
_highlight Symbol
overlapSym
            , _emphasize :: Bool
_emphasize = Symbol -> Bool
_emphasize Symbol
overlapSym
            }
        where
        newText :: Text
newText = Text
prefix
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Int -> Text -> (Text, Text)
textSplitAt (Text -> Int
Realize.textLength Text
prefix) (Symbol -> Text
_text Symbol
sym))

makeSymbols :: Solkattu.Notation stroke => Int -> Tala.Tala -> Set Tala.Akshara
    -> Format.NormalizedFlat stroke -> [(S.State, Symbol)]
makeSymbols :: forall stroke.
Notation stroke =>
Int
-> Tala -> Set Int -> NormalizedFlat stroke -> [(State, Symbol)]
makeSymbols Int
strokeWidth Tala
tala Set Int
angas = Flat Meta (State, Stroke (Note 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
$ State -> (Bool, Style, Text) -> Symbol
makeSymbol State
state ((Bool, Style, Text) -> Symbol) -> (Bool, Style, Text) -> Symbol
forall a b. (a -> b) -> a -> b
$ case Stroke (Note stroke)
note of
            S.Attack Note stroke
a ->
                ( Bool
False
                , Style
style
                , Int -> Char -> Text -> Text
Realize.justifyLeft Int
strokeWidth (Note stroke -> Char
forall a. Notation a => a -> Char
Solkattu.extension Note stroke
a)
                    Text
notation
                )
                where (Style
style, Text
notation) = Note stroke -> (Style, Text)
forall a. Notation a => a -> (Style, Text)
Solkattu.notation Note stroke
a
            S.Sustain Note stroke
a ->
                ( Bool
True
                , Style
forall a. Monoid a => a
mempty
                , Int -> Text -> Text
Text.replicate Int
strokeWidth
                    (Char -> Text
Text.singleton (Note stroke -> Char
forall a. Notation a => a -> Char
Solkattu.extension Note stroke
a))
                )
            Stroke (Note stroke)
S.Rest -> (Bool
True, Style
forall a. Monoid a => a
mempty, Int -> Char -> Text -> Text
Realize.justifyLeft Int
strokeWidth Char
' ' Text
"_")
    go (S.FGroup Tempo
_ Meta
group [Flat Meta (State, Stroke (Note stroke))]
children) = [(State, Symbol)] -> [(State, 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 :: [(State, Symbol)] -> [(State, Symbol)]
modify = case Meta -> GroupType
Solkattu._type Meta
group of
            GroupType
Solkattu.GGroup -> [(State, Symbol)] -> [(State, Symbol)]
forall {a}. [(a, Symbol)] -> [(a, Symbol)]
groupc
            GroupType
Solkattu.GReductionT -> [(State, Symbol)] -> [(State, Symbol)]
forall {a}. [(a, Symbol)] -> [(a, Symbol)]
groupc
            GroupType
Solkattu.GFiller -> Color -> [(State, Symbol)] -> [(State, Symbol)]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
Color -> [p a Symbol] -> [p a Symbol]
setHighlights2 (Float -> Color
gray Float
0.85)
            GroupType
Solkattu.GPattern -> [(State, Symbol)] -> [(State, Symbol)]
forall {a}. [(a, Symbol)] -> [(a, Symbol)]
patternc
            GroupType
Solkattu.GExplicitPattern -> [(State, Symbol)] -> [(State, Symbol)]
forall {a}. [(a, Symbol)] -> [(a, Symbol)]
patternc
            GroupType
Solkattu.GSarva -> Color -> [(State, Symbol)] -> [(State, Symbol)]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
Color -> [p a Symbol] -> [p a Symbol]
setHighlights2 (Float -> Float -> Float -> Color
Styled.rgb Float
0.5 Float
0.65 Float
0.5)
            -- This shouldn't be here, so make it red.
            Solkattu.GCheckDuration {} -> Color -> [(State, Symbol)] -> [(State, Symbol)]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
Color -> [p a Symbol] -> [p a Symbol]
setHighlights2 (Float -> Float -> Float -> Color
Styled.rgb Float
0.75 Float
0 Float
0)
    groupc :: [(a, Symbol)] -> [(a, Symbol)]
groupc = Color -> Color -> [(a, Symbol)] -> [(a, Symbol)]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
Color -> Color -> [p a Symbol] -> [p a Symbol]
setHighlights (Float -> Float -> Float -> Color
Styled.rgb Float
0.5 Float
0.75 Float
0.5) (Float -> Color
gray Float
0.75)
    patternc :: [(a, Symbol)] -> [(a, Symbol)]
patternc = Color -> Color -> [(a, Symbol)] -> [(a, Symbol)]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
Color -> Color -> [p a Symbol] -> [p a Symbol]
setHighlights
        (Float -> Float -> Float -> Color
Styled.rgb Float
0.55 Float
0.55 Float
0.7) (Float -> Float -> Float -> Color
Styled.rgb Float
0.65 Float
0.65 Float
0.8)
    gray :: Float -> Color
gray Float
n = Float -> Float -> Float -> Color
Styled.rgb Float
n Float
n Float
n
    setHighlights2 :: Color -> [p a Symbol] -> [p a Symbol]
setHighlights2 Color
color = Color -> Color -> [p a Symbol] -> [p a Symbol]
forall {p :: * -> * -> *} {a}.
Bifunctor p =>
Color -> Color -> [p a Symbol] -> [p a Symbol]
setHighlights Color
color Color
color
    setHighlights :: Color -> Color -> [p a Symbol] -> [p a Symbol]
setHighlights Color
startColor Color
color =
        (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 (Highlight -> Color -> Symbol -> Symbol
set Highlight
Format.EndHighlight Color
color))
        ([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 (Highlight -> Color -> Symbol -> Symbol
set Highlight
Format.StartHighlight Color
startColor))
            ((Symbol -> Symbol) -> p a Symbol -> p a Symbol
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Highlight -> Color -> Symbol -> Symbol
set Highlight
Format.Highlight Color
color))
        where
        set :: Highlight -> Color -> Symbol -> Symbol
set Highlight
h Color
color Symbol
sym = case Symbol -> Maybe (Highlight, Color)
_highlight Symbol
sym of
            Maybe (Highlight, Color)
Nothing -> Symbol
sym { _highlight :: Maybe (Highlight, Color)
_highlight = (Highlight, Color) -> Maybe (Highlight, Color)
forall a. a -> Maybe a
Just (Highlight
h, Color
color) }
            -- Don't set highlight if it's already set.  This means the
            -- innermost group's highlight will show, which seems to be most
            -- useful in practice.
            Just (Highlight, Color)
_ -> Symbol
sym
    makeSymbol :: State -> (Bool, Style, Text) -> Symbol
makeSymbol State
state (Bool
isSustain, Style
style, Text
text) = Symbol
        { _text :: Text
_text = Text
text
        , _style :: Style
_style = Style
style
        , _isSustain :: Bool
_isSustain = Bool
isSustain
        , _emphasize :: Bool
_emphasize = Tala -> Set Int -> State -> Bool
shouldEmphasize Tala
tala Set Int
angas State
state
        , _highlight :: Maybe (Highlight, Color)
_highlight = Maybe (Highlight, Color)
forall a. Maybe a
Nothing
        }

-- | Chapu talams are generally fast, so only emphasize the angas.  Other talas
-- are slower, and without such a strong beat, so emphasize every akshara.
shouldEmphasize :: Tala.Tala -> Set Tala.Akshara -> S.State -> Bool
shouldEmphasize :: Tala -> Set Int -> State -> Bool
shouldEmphasize Tala
tala Set Int
angas State
state
    | Bool
isChapu = Set Int -> State -> Bool
Format.onAnga Set Int
angas State
state
    | Bool
otherwise = State -> Bool
Format.onAkshara State
state
    where
    isChapu :: Bool
isChapu = case Tala -> [Anga]
Tala._angas Tala
tala of
        Tala.Wave Int
_ : [Anga]
_ -> Bool
True
        Tala.Clap Int
_ : [Anga]
_ -> Bool
True
        [Anga]
_ -> Bool
False

-- | If the text goes over the width, break at the middle akshara, or the
-- last one before the width if there isn't a middle.
breakLine :: Int -> [(S.State, Symbol)] -> [[(S.State, Symbol)]]
breakLine :: Int -> [(State, Symbol)] -> [[(State, Symbol)]]
breakLine Int
maxWidth [(State, Symbol)]
notes
    | Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxWidth = [[(State, Symbol)]
notes]
    | Int -> Bool
forall a. Integral a => a -> Bool
even Int
aksharas = Int -> [(State, Symbol)] -> [[(State, Symbol)]]
forall {b}. Int -> [(State, b)] -> [[(State, b)]]
breakAt (Int
aksharas Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [(State, Symbol)]
notes
    | Bool
otherwise = Int -> [(State, Symbol)] -> [[(State, Symbol)]]
breakBefore Int
maxWidth [(State, Symbol)]
notes
    where
    width :: Int
width = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((State, Symbol) -> Int) -> [(State, Symbol)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol -> Int
symLength (Symbol -> Int)
-> ((State, Symbol) -> Symbol) -> (State, Symbol) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State, Symbol) -> Symbol
forall a b. (a, b) -> b
snd) [(State, Symbol)]
notes
    aksharas :: Int
aksharas = ((State, Symbol) -> Bool) -> [(State, Symbol)] -> Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Int
Seq.count (State -> Bool
Format.onAkshara (State -> Bool)
-> ((State, Symbol) -> State) -> (State, Symbol) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State, Symbol) -> State
forall a b. (a, b) -> a
fst) [(State, Symbol)]
notes
    breakAt :: Int -> [(State, b)] -> [[(State, b)]]
breakAt Int
akshara = ([(State, b)], [(State, b)]) -> [[(State, b)]]
forall {a}. (a, a) -> [a]
pairToList (([(State, b)], [(State, b)]) -> [[(State, b)]])
-> ([(State, b)] -> ([(State, b)], [(State, b)]))
-> [(State, b)]
-> [[(State, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State, b) -> Bool)
-> [(State, b)] -> ([(State, b)], [(State, b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
akshara) (Int -> Bool) -> ((State, b) -> Int) -> (State, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
S.stateAkshara (State -> Int) -> ((State, b) -> State) -> (State, b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State, b) -> State
forall a b. (a, b) -> a
fst)
    pairToList :: (a, a) -> [a]
pairToList (a
a, a
b) = [a
a, a
b]

-- | Yet another word-breaking algorithm.  I must have 3 or 4 of these by now.
breakBefore :: Int -> [(S.State, Symbol)] -> [[(S.State, Symbol)]]
breakBefore :: Int -> [(State, Symbol)] -> [[(State, Symbol)]]
breakBefore Int
maxWidth =
    [[(State, Symbol)]] -> [[(State, Symbol)]]
go ([[(State, Symbol)]] -> [[(State, Symbol)]])
-> ([(State, Symbol)] -> [[(State, Symbol)]])
-> [(State, Symbol)]
-> [[(State, Symbol)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(State, Symbol)] -> Bool)
-> [[(State, Symbol)]] -> [[(State, Symbol)]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile [(State, Symbol)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[(State, Symbol)]] -> [[(State, Symbol)]])
-> ([(State, Symbol)] -> [[(State, Symbol)]])
-> [(State, Symbol)]
-> [[(State, Symbol)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State, Symbol) -> Bool)
-> [(State, Symbol)] -> [[(State, Symbol)]]
forall a. (a -> Bool) -> [a] -> [[a]]
Seq.split_before (State -> Bool
Format.onAkshara (State -> Bool)
-> ((State, Symbol) -> State) -> (State, Symbol) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State, Symbol) -> State
forall a b. (a, b) -> a
fst)
    where
    go :: [[(State, Symbol)]] -> [[(State, Symbol)]]
go [[(State, Symbol)]]
aksharas =
        case (Int -> Bool)
-> [(Int, [(State, Symbol)])]
-> ([[(State, Symbol)]], [[(State, Symbol)]])
forall key a. (key -> Bool) -> [(key, a)] -> ([a], [a])
breakFst (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
maxWidth) ([Int] -> [[(State, Symbol)]] -> [(Int, [(State, Symbol)])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[(State, Symbol)]] -> [Int]
forall {a}. [[(a, Symbol)]] -> [Int]
runningWidth [[(State, Symbol)]]
aksharas) [[(State, Symbol)]]
aksharas) of
            ([], []) -> []
            ([[(State, Symbol)]]
pre, []) -> [[[(State, Symbol)]] -> [(State, Symbol)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(State, Symbol)]]
pre]
            ([], [(State, Symbol)]
post:[[(State, Symbol)]]
posts) -> [(State, Symbol)]
post [(State, Symbol)] -> [[(State, Symbol)]] -> [[(State, Symbol)]]
forall a. a -> [a] -> [a]
: [[(State, Symbol)]] -> [[(State, Symbol)]]
go [[(State, Symbol)]]
posts
            ([[(State, Symbol)]]
pre, [[(State, Symbol)]]
post) -> [[(State, Symbol)]] -> [(State, Symbol)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(State, Symbol)]]
pre [(State, Symbol)] -> [[(State, Symbol)]] -> [[(State, Symbol)]]
forall a. a -> [a] -> [a]
: [[(State, Symbol)]] -> [[(State, Symbol)]]
go [[(State, Symbol)]]
post
    -- drop 1 so it's the width at the end of each section.
    runningWidth :: [[(a, Symbol)]] -> [Int]
runningWidth = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 ([Int] -> [Int])
-> ([[(a, Symbol)]] -> [Int]) -> [[(a, Symbol)]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> [Int])
-> ([[(a, Symbol)]] -> [Int]) -> [[(a, Symbol)]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, Symbol)] -> Int) -> [[(a, Symbol)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> ([(a, Symbol)] -> [Int]) -> [(a, Symbol)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Symbol) -> Int) -> [(a, Symbol)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol -> Int
symLength (Symbol -> Int) -> ((a, Symbol) -> Symbol) -> (a, Symbol) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Symbol) -> Symbol
forall a b. (a, b) -> b
snd))

-- ** formatting

data Symbol = Symbol {
    Symbol -> Text
_text :: !Text
    , Symbol -> Style
_style :: !Styled.Style
    , Symbol -> Bool
_isSustain :: !Bool
    , Symbol -> Bool
_emphasize :: !Bool
    , Symbol -> Maybe (Highlight, Color)
_highlight :: !(Maybe (Format.Highlight, Styled.Color))
    } 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 -> String
(Int -> Symbol -> ShowS)
-> (Symbol -> String) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> String
$cshow :: Symbol -> String
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show)

instance Pretty Symbol where
    pretty :: Symbol -> Text
pretty (Symbol Text
text Style
_style Bool
_isSustain Bool
emphasize Maybe (Highlight, Color)
highlight) =
        Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
emphasize then Text
"(b)" else Text
"")
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe (Highlight, Color)
highlight of
            Maybe (Highlight, Color)
Nothing -> Text
""
            Just (Highlight
Format.StartHighlight, Color
_) -> Text
"+"
            Just (Highlight
Format.Highlight, Color
_) -> Text
"-"
            Just (Highlight
Format.EndHighlight, Color
_) -> Text
"|"

formatSymbol :: Symbol -> Styled.Styled
formatSymbol :: Symbol -> Styled
formatSymbol (Symbol Text
text Style
style Bool
_isSustain Bool
emph Maybe (Highlight, Color)
highlight) =
    (case Maybe (Highlight, Color)
highlight of
        Maybe (Highlight, Color)
Nothing -> Styled -> Styled
forall a. a -> a
id
        Just (Highlight
Format.StartHighlight, Color
color) -> Color -> Styled -> Styled
forall a. ToStyled a => Color -> a -> Styled
Styled.bg Color
color
        Just (Highlight
_, Color
color) -> Color -> Styled -> Styled
forall a. ToStyled a => Color -> a -> Styled
Styled.bg Color
color
    ) (Styled -> Styled) -> Styled -> Styled
forall a b. (a -> b) -> a -> b
$
    Style -> Styled -> Styled
forall a. ToStyled a => Style -> a -> Styled
Styled.styled Style
style (Styled -> Styled) -> Styled -> Styled
forall a b. (a -> b) -> a -> b
$ (if Bool
emph then Text -> Styled
emphasize else Text -> Styled
Styled.plain) Text
text
    where
    emphasize :: Text -> Styled
emphasize Text
word
        -- A bold _ looks similar to a non-bold one, so put a bar to make it
        -- more obvious.
        | Text
"_ " Text -> Text -> Bool
`Text.isPrefixOf` Text
word = Text -> Styled
emphasize Text
"_|"
        | Text
"‗ " Text -> Text -> Bool
`Text.isPrefixOf` Text
word = Text -> Styled
emphasize Text
"‗|"
        | Bool
otherwise = Text -> Styled
emphasisStyle Text
word

emphasisStyle :: Text -> Styled.Styled
emphasisStyle :: Text -> Styled
emphasisStyle = Color -> Styled -> Styled
forall a. ToStyled a => Color -> a -> Styled
Styled.fg Color
red (Styled -> Styled) -> (Text -> Styled) -> Text -> Styled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Styled
forall a. ToStyled a => a -> Styled
Styled.bold
    where red :: Color
red = Float -> Float -> Float -> Color
Styled.rgb (Float
0xa1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0xff) (Float
0x13 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0xff) Float
0
    -- I'm used to this dark red since it's what iterm used for bold.

symLength :: Symbol -> Int
symLength :: Symbol -> Int
symLength = Text -> Int
Realize.textLength (Text -> Int) -> (Symbol -> Text) -> Symbol -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Text
_text

textSplitAt :: Int -> Text -> (Text, Text)
textSplitAt :: Int -> Text -> (Text, Text)
textSplitAt Int
at Text
text =
    [(Text, Text)] -> (Text, Text)
find ([(Text, Text)] -> (Text, Text)) -> [(Text, Text)] -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ (Int -> (Text, Text)) -> [Int] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Text -> (Text, Text)) -> Text -> Int -> (Text, Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> (Text, Text)
Text.splitAt Text
text) [Int
0 .. Text -> Int
Realize.textLength Text
text]
    where
    find :: [(Text, Text)] -> (Text, Text)
find ((Text, Text)
cur : next :: [(Text, Text)]
next@((Text
pre, Text
_) : [(Text, Text)]
_))
        | Text -> Int
Realize.textLength Text
pre Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
at = (Text, Text)
cur
        | Bool
otherwise = [(Text, Text)] -> (Text, Text)
find [(Text, Text)]
next
    find [(Text, Text)]
_ = (Text
text, Text
"")

-- * util

breakFst :: (key -> Bool) -> [(key, a)] -> ([a], [a])
breakFst :: forall key a. (key -> Bool) -> [(key, a)] -> ([a], [a])
breakFst key -> Bool
f = ([(key, a)] -> [a])
-> ([(key, a)] -> [a]) -> ([(key, a)], [(key, a)]) -> ([a], [a])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (((key, a) -> a) -> [(key, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (key, a) -> a
forall a b. (a, b) -> b
snd) (((key, a) -> a) -> [(key, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (key, a) -> a
forall a b. (a, b) -> b
snd) (([(key, a)], [(key, a)]) -> ([a], [a]))
-> ([(key, a)] -> ([(key, a)], [(key, a)]))
-> [(key, a)]
-> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((key, a) -> Bool) -> [(key, a)] -> ([(key, a)], [(key, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (key -> Bool
f (key -> Bool) -> ((key, a) -> key) -> (key, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (key, a) -> key
forall a b. (a, b) -> a
fst)

-- | I think lenses are the way to lift mapAccumL into second.
mapAccumLSnd :: (state -> a -> (state, b)) -> state -> [(x, a)]
    -> (state, [(x, b)])
mapAccumLSnd :: forall state a b x.
(state -> a -> (state, b))
-> state -> [(x, a)] -> (state, [(x, b)])
mapAccumLSnd state -> a -> (state, b)
f state
state = (state -> (x, a) -> (state, (x, b)))
-> state -> [(x, a)] -> (state, [(x, b)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL state -> (x, a) -> (state, (x, b))
f2 state
state
    where
    f2 :: state -> (x, a) -> (state, (x, b))
f2 state
state (x
x, a
a) = (state
state2, (x
x, b
b))
        where (state
state2, b
b) = state -> a -> (state, b)
f state
state a
a