add Mridangam._printStrokes, move combining-char sensitive utils to T…

…exts

Solkattu/Format/Terminal.hs

@@ -327,7 +327,7 @@ spellRests strokeWidth
     set (col, (prev, sym, next))
         | not (isRest sym) = sym
         | even col && maybe False isRest next = sym
-            { _text = Realize.justifyLeft (symWidth sym) ' ' double }
+            { _text = Texts.justifyLeft (symWidth sym) ' ' double }
         | odd col && maybe False isRest prev = sym
             { _text = Text.replicate (symWidth sym) " " }
         | otherwise = sym
@@ -345,10 +345,10 @@ overlapSymbols strokeWidth = snd . mapAccumLSnd combine ("", Nothing)
     combine (overlap, overlapSym) sym
         | _isSustain sym = if Text.null overlap
             then (("", Nothing), sym)
-            else let (pre, post) = Realize.textSplitAt strokeWidth overlap
+            else let (pre, post) = Texts.splitAt strokeWidth overlap
                 in ((post, overlapSym), replace pre overlapSym sym)
         | otherwise =
-            let (pre, post) = Realize.textSplitAt strokeWidth (_text sym)
+            let (pre, post) = Texts.splitAt strokeWidth (_text sym)
             in ((post, Just sym), sym { _text = pre })
     replace prefix mbOverlapSym sym = case mbOverlapSym of
         Nothing -> sym { _text = newText }
@@ -360,7 +360,7 @@ overlapSymbols strokeWidth = snd . mapAccumLSnd combine ("", Nothing)
             }
         where
         newText = prefix
-            <> snd (Realize.textSplitAt (Realize.textLength prefix) (_text sym))
+            <> snd (Texts.splitAt (Texts.length prefix) (_text sym))
 
 makeSymbols :: Solkattu.Notation stroke => Int -> Talas.Tala -> Set Tala.Akshara
     -> Format.NormalizedFlat stroke -> [(S.State, Symbol)]
@@ -371,8 +371,7 @@ makeSymbols strokeWidth tala angas = go
             S.Attack a ->
                 ( False
                 , style
-                , Realize.justifyLeft strokeWidth (Solkattu.extension a)
-                    notation
+                , Texts.justifyLeft strokeWidth (Solkattu.extension a) notation
                 )
                 where (style, notation) = Solkattu.notation a
             S.Sustain a ->
@@ -381,7 +380,7 @@ makeSymbols strokeWidth tala angas = go
                 , Text.replicate strokeWidth
                     (Text.singleton (Solkattu.extension a))
                 )
-            S.Rest -> (True, mempty, Realize.justifyLeft strokeWidth ' ' "_")
+            S.Rest -> (True, mempty, Texts.justifyLeft strokeWidth ' ' "_")
     go (S.FGroup _ group children) = modify (concatMap go children)
         where
         modify = case Solkattu._type group of
@@ -483,7 +482,7 @@ emphasisStyle = Styled.fg red . Styled.bold
     -- I'm used to this dark red since it's what iterm used for bold.
 
 symWidth :: Symbol -> Int
-symWidth = Realize.textLength . _text
+symWidth = Texts.length . _text
 
 -- * util
 

Solkattu/Instrument/Mridangam.hs

@@ -10,10 +10,12 @@ module Solkattu.Instrument.Mridangam where
 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           GHC.Stack (HasCallStack)
 
 import qualified Util.Lists as Lists
+import qualified Util.Texts as Texts
 import qualified Derive.Expr as Expr
 import qualified Derive.Symbols as Symbols
 import qualified Solkattu.Realize as Realize
@@ -144,6 +146,17 @@ instance Solkattu.Notation Valantalai where
 instance Pretty Thoppi where pretty = Solkattu.notationText
 instance Pretty Valantalai where pretty = Solkattu.notationText
 
+_printStrokes :: IO ()
+_printStrokes = mapM_ Text.IO.putStrLn $ Texts.columns 2 $
+    [ "" : map (t . Valantalai) rhs ] ++
+    [ (map t $ Thoppi lh : [Both lh rh | rh <- rhs])
+    | lh <- lhs
+    ]
+    where
+    t = Solkattu.notationText
+    rhs = [Ki ..]
+    lhs = [Tha Palm, Tha Fingertips, Thom Low, Thom Up, Gum]
+
 -- | Pretty reproduces the "Derive.Solkattu.Dsl" syntax, which has to be
 -- haskell syntax, so it can't use +, and I have to put thoppi first to avoid
 -- the keyword @do@.  It would be nice if I could make the tracklang syntax

Solkattu/Realize.hs

@@ -46,11 +46,6 @@ module Solkattu.Realize (
     -- ** ToStroke
     , ToStrokes
     , realizeStroke, realizeSollu
-    -- * text util
-    , justifyLeft
-    , textLength
-    , textSplitAt
-
     -- * DEBUG
     , SolluMap(..)
     , solluMap
@@ -624,7 +619,7 @@ formatError = format . UF.toList
     format (pre, Just err) = Left $
         Texts.unlines2 (errorNotation (S.flattenedNotes pre)) err
     errorNotation = Text.unwords
-        . map (justifyLeft 2 ' ' . Solkattu.notationText)
+        . map (Texts.justifyLeft 2 ' ' . Solkattu.notationText)
 
 {- | Given a group like
 
@@ -810,35 +805,3 @@ bestMatch tag sollus toStrokes =
     find tag = mapMaybe (\s -> ((tag, s),) <$> _getStrokes toStrokes tag s)
     prefixes = reverse $ drop 1 $ List.inits $
         take (_longestKey toStrokes) sollus
-
-
--- * text util
-
-justifyLeft :: Int -> Char -> Text -> Text
-justifyLeft n c text
-    | len >= n = text
-    | otherwise = text <> Text.replicate (n - len) (Text.singleton c)
-    where len = textLength text
-
--- | Text.length that doesn't count combining characters.
---
--- TODO there is surely a canonical way to count graphemes, say using text-icu,
--- but it seems like a heavy dependency.
-textLength :: Text -> Int
-textLength = Num.sum . map len . untxt
-    where
-    -- Combining characters don't contribute to the width.  I'm sure it's way
-    -- more complicated than this, but for the moment this seems to work.
-    len c
-        | Char.isMark c = 0
-        | otherwise = 1
-
--- | Text.splitAt that isn't confused by combining characters.
-textSplitAt :: Int -> Text -> (Text, Text)
-textSplitAt at text =
-    find $ map (flip Text.splitAt text) [0 .. textLength text]
-    where
-    find (cur : next@((pre, _) : _))
-        | textLength pre > at = cur
-        | otherwise = find next
-    find _ = (text, "")

TODO

@@ -6329,6 +6329,23 @@ solkattu:
       . Another way is to support them all, but map them the same way to
         strokes.  Good because the original notation is preserved.
         Currently I do this, maybe it's good enough.
+  mridangam gumiki notation:
+    . Firstly, Gum is confusing because it's a "dry" stroke.  But I think
+      it is useful for timed gum, just the name is confusing.  Maybe it
+      should be Up, but that's Thoppi Up.
+    . Previously, gum is /, and Thom Up is acute accent.
+      Gum as / can't be combined with other things.
+      Acute accent can't be combined well with symbols like , ^.
+    . Making Up into a trailing / solves those, at the cost of 2 chars.
+      But it seems ok and I think not bad to read.  Better than acute.
+    . But gum as bare ´ is pretty annoying to type.  Bare / makes a kind of
+      sense because it's just up, no o.
+    . I could make / -> gum, and have to type ó for o/ in strings, that makes
+      some sense, but it's a confusing mismatch between fromString and output
+      notation.  Of course I have those for many things, but
+    . Maybe it comes down to how common is Up vs Gum.
+      If ´ is really so annoying, then I could use `, or even ', is that
+      otherwise used?
   notation conveniences:
     / mark karvai groups automatically?  I don't have to highlight it.
       . If I'm not going to highlight, why bother?

Util/Texts.hs

@@ -3,8 +3,27 @@
 -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt
 
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
-module Util.Texts where
-import           Prelude hiding (lines)
+module Util.Texts (
+    Textlike(..)
+    , replaceMany
+    , unwords2, unlines2, join2, join
+    , split1
+    , ellipsis, ellipsisList
+    , dropPrefix, dropSuffix
+    , enumeration
+    , columns, columnsSome
+    , justifyLeft
+    , length
+    , splitAt
+    , mapDelimited, mapDelimitedM, extractDelimited
+    -- * interpolate
+    , interpolate
+    -- * haddockUrl
+    , Files, Url
+    , haddockUrl
+) where
+import           Prelude hiding (length, lines, splitAt)
+import qualified Prelude
 import           Control.Arrow (first)
 import           Control.Monad (liftM)
 import qualified Control.Monad.Identity as Identity
@@ -29,6 +48,7 @@ import qualified System.FilePath as FilePath
 import           System.FilePath ((</>))
 
 import qualified Util.Lists as Lists
+import qualified Util.Num as Num
 import qualified Util.Regex as Regex
 
 
@@ -97,9 +117,6 @@ join2 sep a b = join sep $ filter (not . Text.null . toText) [a, b]
 join :: Textlike a => a -> [a] -> a
 join sep = fromText . Text.intercalate (toText sep) . map toText
 
-unlines :: Textlike a => [a] -> a
-unlines = fromText . Text.unlines . map toText
-
 split1 :: Text -> Text -> (Text, Text)
 split1 sep text = (pre, Text.drop (Text.length sep) post)
     where (pre, post) = Text.breakOn sep text
@@ -113,7 +130,7 @@ ellipsisList :: Int -> [Text] -> [Text]
 ellipsisList max xs
     | null post = xs
     | otherwise = pre ++ ["..."]
-    where (pre, post) = splitAt max xs
+    where (pre, post) = Prelude.splitAt max xs
 
 dropPrefix :: Text -> Text -> Text
 dropPrefix prefix text = Maybe.fromMaybe text (Text.stripPrefix prefix text)
@@ -133,10 +150,39 @@ columnsSome :: Int -> [Either Text [Text]] -> [Text]
 columnsSome padding rows = map formatRow rows
     where
     formatRow = either id (Text.stripEnd . mconcat . zipWith pad widths)
-    pad w = Text.justifyLeft (w + padding) ' '
+    pad w = justifyLeft (w + padding) ' '
     byCol = map (map (Maybe.fromMaybe Text.empty))
         (Lists.rotate2 (Either.rights rows))
-    widths = map (List.maximum . (0:) . map Text.length) byCol
+    widths = map (List.maximum . (0:) . map length) byCol
+
+justifyLeft :: Int -> Char -> Text -> Text
+justifyLeft count c text
+    | len >= count = text
+    | otherwise = text <> Text.replicate (count - len) (Text.singleton c)
+    where len = length text
+
+-- | Text.length that doesn't count combining characters.
+--
+-- TODO there is surely a canonical way to count graphemes, say using text-icu,
+-- but it seems like a heavy dependency.
+length :: Text -> Int
+length = Num.sum . map len . Text.unpack
+    where
+    -- Combining characters don't contribute to the width.  I'm sure it's way
+    -- more complicated than this, but for the moment this seems to work.
+    len c
+        | Char.isMark c = 0
+        | otherwise = 1
+
+-- | Text.splitAt that isn't confused by combining characters.
+splitAt :: Int -> Text -> (Text, Text)
+splitAt at text =
+    find $ map (flip Text.splitAt text) [0 .. length text]
+    where
+    find (cur : next@((pre, _) : _))
+        | length pre > at = cur
+        | otherwise = find next
+    find _ = (text, "")
 
 -- | Apply a function to the contents delimited by the given Char.  You can
 -- quote a delimiter with a backslash.