squash a warning

cabal.project

@@ -5,6 +5,4 @@ packages:
 source-repository-package
   type: git
   location: https://git.rhiannon.website/rhi/svg-builder
-  tag: 1cbcd594d3009f9fd71f253b52ac82673bf5482e
-
-allow-newer: *
+  tag: 39bb6a4e04ec2caccc23576b062ebfa0566bfb96

laantas-script/GlyphsBase.hs

@@ -3,13 +3,23 @@ module GlyphsBase (module GlyphsBase, module Svg) where
 import Svg hiding (shiftX, shiftY, shift, width, size)
 import qualified Svg
 
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Semigroup (sconcat)
+import Prelude hiding (Word)
+import Data.Foldable
 import Numeric
 import Prelude hiding (Word)
 
 
-data Glyph = G {path :: Segs, width :: Double}
+data Glyph = G {path :: Segs, size :: SizeInfo}
+
+data SizeInfo = SI {
+    width  :: Double, -- ^ total width
+    right  :: Double, -- ^ attachment point for e.g. a
+    center :: Double  -- ^ attachment point for e.g. á
+  }
+
+simpleG :: Segs -> Double -> Glyph
+simpleG path width =
+  G {path, size = SI {width, right = width, center = width/2}}
 
 -- | base amounts
 charHeight', lineHeight', spaceWidth', gap' :: Double
@@ -74,23 +84,39 @@ run m e@(E {size}) =
            textWidth = 0, textHeight = 0, firstOnLine = True}
 
 
-type EGlyph = (Glyph, [Segs])
-type Word   = [EGlyph]
+type Word = [EGlyph]
+
+type EGlyph = (Glyph, [Diacritic])
+
+type Diacritic' a = SizeInfo -> (Segs, a)
+type Diacritic = Diacritic' Double
+
+simpleDia :: Segs -> Diacritic
+simpleDia ss (SI {width}) = (ss, width)
 
 doGlyphs :: [Word] -> Env -> Element
 doGlyphs gs e = wrap $ run act e where
   act = do
     E {stroke, color} <- ask
     let gattrs = [Stroke_ <<- color, Stroke_width_ <<- toPx stroke,
-                  Stroke_linecap_ <<- "round", Fill_ <<- "none"]
+                  Stroke_linecap_ <<- "round", Stroke_linejoin_ <<- "round",
+                  Fill_ <<- "none"]
     g_ gattrs . mconcat <$> traverse placeWord gs <* newline
   wrap (content, T {width, height}) =
     let sattrs = [Height_ <<- toPx height, Width_ <<- toPx width] in
     doctype <> svg11_ content `with` sattrs
 
 
+liftDia :: Diacritic -> Diacritic' SizeInfo
+liftDia f sz@(SI {..}) = let (x, w) = f sz in (x, SI {width = w, ..})
+
 glyphWidth :: EGlyph -> M Double
-glyphWidth (G {width}, _) = (+) <$> withSize (* width) <*> gap
+glyphWidth (G {size}, ss) =
+  let SI {width} = foldl (\x f -> snd $ liftDia f x) size ss in
+  (+) <$> withSize (* width) <*> gap
+
+totalWidth :: Double -> M Double
+totalWidth width = (+) <$> withSize (* width) <*> gap
 
 wordWidth :: Word -> M Double
 wordWidth = fmap sum . traverse glyphWidth
@@ -110,11 +136,17 @@ placeWord w = do
   pure e
 
 placeGlyph :: EGlyph -> M Element
-placeGlyph g@(G {path = path1}, segss) = do
-  gwidth <- glyphWidth g
-  path' <- joinSegs $ sconcat (path1 :| segss)
-  modify \s@(S {x}) -> s {x = x + gwidth}
-  pure $ path_ [D_ <<- path']
+placeGlyph (G {path = path1, size}, dias) = do
+  let (segs', width') = placeDias size dias
+  path <- joinSegs $ path1 <> segs'
+  width <- totalWidth width'
+  modify \s@(S {x}) -> s {x = x + width}
+  pure $ path_ [D_ <<- path]
+
+placeDias :: SizeInfo -> [Diacritic] -> (Segs, Double)
+placeDias sz =
+  unlift . flip runState sz . fmap fold . traverse (state . liftDia)
+  where unlift (x, SI {width}) = (x, width)
 
 newline :: M ()
 newline = do

laantas-script/Split.hs

@@ -23,14 +23,17 @@ longestWith name p = try $ go . Text.singleton =<< lcChar where
     Nothing -> fail $ "longestWith " <> name <> ": " <> show acc
     Just x  -> try (do c <- lcChar; go $ Text.snoc acc c) <|> pure x
 
+unthorn :: Text -> Text
+unthorn = Text.map \case 'þ' -> 'ƶ'; 'ð' -> 'ƶ'; c -> c
+
 maxFrom :: String -> Map Text a -> P a
-maxFrom name i = longestWith name \x -> Map.lookup x i
+maxFrom name i = longestWith name \x -> Map.lookup (unthorn x) i
 
 initial :: P Glyph
 initial = maxFrom "initial" initials
 
-medial :: P Segs
-medial = P [] <$ chunk "\\" <|> maxFrom "medial" medials
+medial :: P [Diacritic]
+medial = [] <$ chunk "\\" <|> maxFrom "medial" medials
 
 final :: P Glyph
 final = maxFrom "final" finals
@@ -38,29 +41,29 @@ final = maxFrom "final" finals
 ivowel :: P Glyph
 ivowel = maxFrom "vowel" vowels
 
-word :: P [Piece]
+word :: P [EGlyph]
 word = [is <> f <> concat p | is <- some initMed, f <- fin, p <- many punct]
  where
   initMed = try $
-    [(i, [m]) | i <- initial, m <- medial] <|>
+    (,) <$> initial <*> medial <|>
     [(v, []) | v <- ivowel] <|>
     dash
   fin = maybe [] (\x -> [(x, [])]) <$> optional final
 
-number :: P [Piece]
+number :: P [EGlyph]
 number = some (digit <|> hash) where
   hash = (num, []) <$ chunk "#"
   digit = [(numbers ! Char.digitToInt i, []) | i <- digitChar]
 
-punct :: P [Piece]
+punct :: P [EGlyph]
 punct = [[(p, [])] | p <- maxFrom "punctuation" punctuation] <* space
 
-dash :: P Piece
+dash :: P EGlyph
 dash = (wave, []) <$ chunk "–"
 
-text :: P [[Piece]]
+text :: P [[EGlyph]]
 text = space *> many (segment <* space) <* eof where
   segment = punct <|> number <|> word
 
-split :: Text -> [[Piece]]
+split :: Text -> [[EGlyph]]
 split = either (error . errorBundlePretty) id . parse text ""

laantas-script/Svg.hs

@@ -9,7 +9,8 @@ where
 import Control.Monad.Reader
 import Control.Monad.State
 import qualified Graphics.Svg as Base
-import Graphics.Svg hiding (mA, mR, lA, lR, cA, cR, sA, sR, aA, aR)
+import Graphics.Svg
+  hiding (mA, mR, lA, lR, cA, cR, sA, sR, aA, aR, qA, qR, tA, tR)
 import Data.Text (Text, pack)
 
 
@@ -66,6 +67,28 @@ cR (x1, y1) (x2, y2) (x3, y3) =
             (x3 * size) (y3 * size)
     <> " " -- lmao
 
+qA :: Point -> Point -> M Text
+qA (x1, y1) (x2, y2) =
+  reader \E {size} ->
+    Base.qA (x1 * size) (y1 * size)
+            (x2 * size) (y2 * size)
+
+qR :: Point -> Point -> M Text
+qR (x1, y1) (x2, y2) =
+  reader \E {size} ->
+    Base.qR (x1 * size) (y1 * size)
+            (x2 * size) (y2 * size)
+
+tA :: Point -> M Text
+tA (x1, y1) =
+  reader \E {size} ->
+    Base.tA (x1 * size) (y1 * size)
+
+tR :: Point -> M Text
+tR (x1, y1) =
+  reader \E {size} ->
+    Base.tR (x1 * size) (y1 * size)
+
 
 data Arc = Large | Small
 data Sweep = CW | CCW

laantas-script/laantas-script.cabal

@@ -27,14 +27,15 @@ executable laantas-script
     MultiWayIf,
     NamedFieldPuns,
     OverloadedStrings,
-    RecordWildCards
+    RecordWildCards,
+    ViewPatterns
   build-depends:
-    base >= 4.14.0.0 && < 4.17,
+    base >= 4.14.0.0 && < 4.20,
     containers ^>= 0.6.2.1,
     mtl ^>= 2.2.2,
     svg-builder ^>= 0.1.1,
     optparse-applicative ^>= 0.16.0.0,
-    text ^>= 1.2.3.2,
-    megaparsec ^>= 9.0.1
+    text ^>= 2.1,
+    megaparsec ^>= 9.6.1
   ghc-options:
     -Wall -threaded -rtsopts -with-rtsopts=-N

langfilter/Ebnf.hs

@@ -10,21 +10,23 @@ import Text.Pandoc.Definition
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Void
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
 
 data Rule =
     Rule Text Def
   | RCom Text -- ^ @(* comment *)@
   deriving (Eq, Show)
 data Def =
-    N Text      -- ^ @nonterminal@
-  | T Text      -- ^ @\'terminal\'@ or @\"terminal\"@
-  | S Text      -- ^ @?special?@
-  | Or [Def]    -- ^ choice @a | b | c@
-  | Seq [Def]   -- ^ sequence @a, b, c@
-  | Sub Def Def -- ^ difference @a - b@
-  | Opt Def     -- ^ opt @[a]@
-  | Many Def    -- ^ repetition @{a}@
-  | Com Text    -- ^ comment
+    N Text             -- ^ @nonterminal@
+  | T Text             -- ^ @\'terminal\'@ or @\"terminal\"@
+  | S Text             -- ^ @?special?@
+  | Or  (NonEmpty Def) -- ^ choice @a | b | c@
+  | Seq (NonEmpty Def) -- ^ sequence @a, b, c@
+  | Sub Def Def        -- ^ difference @a - b@
+  | Opt Def            -- ^ opt @[a]@
+  | Many Def           -- ^ repetition @{a}@
+  | Com Text           -- ^ comment
   deriving (Eq, Show)
 
 
@@ -51,9 +53,9 @@ render1 (RCom txt) =
 render1 (Rule name def) =
   row' [span "ebnf-nt" name] "=" d : map (row' [] "|") ds
  where
-  d:ds = splitOrs def
+  d :| ds = splitOrs def
   splitOrs (Or ds) = ds
-  splitOrs d       = [d]
+  splitOrs d       = NonEmpty.singleton d
   row' c1 p d = Row mempty [cell c1, cell [punc p], cell (renderDef d)]
   cell is = Cell mempty AlignDefault (RowSpan 1) (ColSpan 1) [Plain is]
 
@@ -76,9 +78,9 @@ renderDefAt p = \case
   T txt -> [span "ebnf-t" txt]
   S txt -> [span "ebnf-s" txt]
   Or ds -> renderParens (p > OR) $
-    intercalate [Space, punc "|", Space] $ renderDefAt OR <$> ds
+    intercalate [Space, punc "|", Space] $ renderDefAt OR <$> NonEmpty.toList ds
   Seq ds -> renderParens (p > SEQ) $
-    intercalate [punc ",", Space] $ renderDefAt SEQ <$> ds
+    intercalate [punc ",", Space] $ renderDefAt SEQ <$> NonEmpty.toList ds
   Sub d e -> renderParens (p >= SUB) $
     renderDefAt SUB d <>
     [Space, span "ebnf-sub" "−", Space] <>
@@ -111,10 +113,13 @@ def :: P Def
 def = ors
 
 ors :: P Def
-ors = list Or <$> seqs `sepBy1` (sym "|")
+ors = list1 Or <$> seqs `sepBy1'` (sym "|")
 
 seqs :: P Def
-seqs = list Seq <$> sub `sepBy1` (sym ",")
+seqs = list1 Seq <$> sub `sepBy1'` (sym ",")
+
+sepBy1' :: P a -> P z -> P (NonEmpty a)
+sepBy1' a b = NonEmpty.fromList <$> sepBy1 a b
 
 sub :: P Def
 sub = do
@@ -154,9 +159,9 @@ comment = do try (string_ "(*"); go ["(*"] 1 where
 bracketed :: (Def -> a) -> Char -> Char -> P a
 bracketed f o c = f <$> between (char' o) (char' c) def
 
-list :: ([a] -> a) -> [a] -> a
-list _ [x] = x
-list f xs  = f xs
+list1 :: (NonEmpty a -> a) -> NonEmpty a -> a
+list1 _ (x :| []) = x
+list1 f xs        = f xs
 
 
 sym :: Text -> P Text

langfilter/langfilter.cabal

@@ -33,11 +33,11 @@ executable langfilter
     RecordWildCards,
     ViewPatterns
   build-depends:
-    base >= 4.14.0.0 && < 4.17,
+    base >= 4.14.0.0 && < 4.20,
     containers ^>= 0.6.2.1,
     filepath ^>= 1.4.2.1,
-    megaparsec ^>= 9.0.1,
+    megaparsec ^>= 9.6.1,
     process ^>= 1.6.11.0,
     pandoc-types ^>= 1.23,
-    text,
+    text ^>= 2.1,
     pretty-show ^>= 1.10

pages/laantas/words.yaml

@@ -79,13 +79,12 @@ guwan:
   d:
     - sun
     - day
+    - guwanḿ: summer (jun-aug)
 
 ǧáhnu:
   p: ˈdʒaːx.nu
   t: n
-  d:
-    - autumn
-    - ǧáhnut: brown, orange
+  d: brown, orange
 
 ǧima:
   p: ˈdʒi.ma
@@ -1243,6 +1242,18 @@ iksa:
   n:
     - imperative auxiliary
     - only used in second person
+    - if 2sg is the subject of the auxiliary clause too, the marker in that
+      clause can be omitted
+    - can be used alone with an adjectival noun for the object
+  e:
+    - o: šikkúm iksaha
+      t: go away
+    - o: rusmánam iksaha
+      t: let me sleep
+    - o: kait iksaha
+      t: be good
+    - o: ufat iksaha
+      t: stay warm (said on oct 31, the last day before winter)
 
 gari:
   p: ˈɡa.ɾi
@@ -1416,6 +1427,7 @@ ufan:
     - ufat:
         - warm
         - bright
+    - ufit: cozy
 
 bisi:
   p: ˈbi.si
@@ -1505,6 +1517,7 @@ santu:
   d:
     - rain
     - santutippi: rainwater
+    - santum: autumn (sep-oct)
   n: has tippim as subject
 
 kassa:
@@ -1726,8 +1739,8 @@ kauba:
     - intelligence
     - časmát: intelligent
 
-gḿba:
-  p: ˈɡm̩.ba
+guba:
+  p: ˈɡu.ba
   t: {v: i}
   d: [grow, thrive]
 
@@ -2036,3 +2049,38 @@ duguwa:
     - shun
     - avoid
   n: object in APUD-ABL
+
+šani:
+  p: ˈʃa.ni
+  t: n
+  d:
+    - flower
+    - šangubam: spring (mar-may)
+  see: guba
+
+igis:
+  p: ˈiɡ.is
+  t: n
+  d: ice
+
+igisi:
+  p: ˈi.ɡi.si
+  t: {v: t}
+  d:
+    - freeze
+    - igisim: winter (nov-jan)
+    - ƶulkusim: midwinter (solstice)
+  see: [igis, ƶulku]
+
+susuru:
+  p: ˈsu.su.ɾu
+  t: {v: i}
+  d:
+    - melt
+    - susurum: intermediate between winter and spring (feb)
+
+ƶulku:
+  p: ˈdʒul.ku
+  t: {v: i}
+  d: be deep
+  n: not a noun, unlike most adjectives. who knows why

pages/laantas/writing.md

@@ -40,9 +40,9 @@ In other cases, vowels are attached to the letter for the previous consonant.
 The basic consonant shapes are:
 
 :::letter-list
-`{!t\}` `{!k\}` `{!g\}` `{!d\}` `{!ƶ\}` `{!p\}` `{!b\}`
-`{!s\}` `{!š\}` `{!l\}` `{!m\}` `{!n\}` `{!č\}` `{!ǧ\}`
-`{!w\}` `{!h\}` `{!f\}` `{!j\}` `{!r\}`
+`{!ta}` `{!ka}` `{!ga}` `{!da}` `{!ƶa}` `{!pa}` `{!ba}`
+`{!sa}` `{!ša}` `{!la}` `{!ma}` `{!na}` `{!ča}` `{!ǧa}`
+`{!wa}` `{!ha}` `{!fa}` `{!ja}` `{!ra}`
 :::
 
 Clusters are written with a single glyph called a 'conjunct'. These aren't
@@ -61,54 +61,54 @@ surprising.
 </nav>
 
 ::: {.letter-list #conj-t}
-`{!tt\}` `{!tk\}` `{!tg\}` `{!td\}` `{!tƶ\}` `{!tp\}` `{!tb\}` `{!ts\}`
-`{!tš\}` `{!tl\}` `{!tm\}` `{!tn\}` `{!tr\}` `{!tč\}` `{!tǧ\}` `{!tw\}`
-`{!th\}` `{!tf\}` `{!tj\}`
+`{!tta}` `{!tka}` `{!tga}` `{!tda}` `{!tƶa}` `{!tpa}` `{!tba}` `{!tsa}`
+`{!tla}` `{!tma}` `{!tna}` `{!tra}` `{!tča}` `{!tǧa}` `{!twa}` `{!tha}`
+`{!tfa}` `{!tja}`
 :::
 
 ::: {.letter-list #conj-ƶ}
-`{!ƶt\}` `{!ƶk\}` `{!ƶg\}` `{!ƶd\}` `{!ƶƶ\}` `{!ƶp\}` `{!ƶb\}` `{!ƶs\}`
-`{!ƶš\}` `{!ƶl\}` `{!ƶm\}` `{!ƶn\}` `{!ƶr\}` `{!ƶč\}` `{!ƶǧ\}` `{!ƶw\}`
-`{!ƶh\}` `{!ƶf\}` `{!ƶj\}`
+`{!ƶta}` `{!ƶka}` `{!ƶga}` `{!ƶda}` `{!ƶƶa}` `{!ƶpa}` `{!ƶba}` `{!ƶsa}`
+`{!ƶla}` `{!ƶma}` `{!ƶna}` `{!ƶra}` `{!ƶča}` `{!ƶǧa}` `{!ƶwa}` `{!ƶha}`
+`{!ƶfa}` `{!ƶja}`
 :::
 
 ::: {.letter-list #conj-s}
-`{!st\}` `{!sk\}` `{!sg\}` `{!sd\}` `{!sƶ\}` `{!sp\}` `{!sb\}` `{!ss\}`
-`{!sš\}` `{!sl\}` `{!sm\}` `{!sn\}` `{!sr\}` `{!sč\}` `{!sǧ\}` `{!sw\}`
-`{!sh\}` `{!sf\}` `{!sj\}` `{!šš\}`
+`{!sta}` `{!ska}` `{!sga}` `{!sda}` `{!sƶa}` `{!spa}` `{!sba}` `{!ssa}`
+`{!sla}` `{!sma}` `{!sna}` `{!sra}` `{!sča}` `{!sǧa}` `{!swa}` `{!sha}`
+`{!sfa}` `{!sja}` `{!šša}`
 :::
 
-Conjuncts with `{!š\}` are the same as with `{!s\}`, but with the line above. In
-the case of `{!šš\}` the lines join up.
+Conjuncts with `{!ša}` are the same as with `{!sa}`, but with the line above. In
+the case of `{!šša}` the lines join up.
 
 ::: {.letter-list #conj-l}
-`{!lt\}` `{!lk\}` `{!lg\}` `{!ld\}` `{!lƶ\}` `{!lp\}` `{!lb\}` `{!ls\}`
-`{!lš\}` `{!ll\}` `{!lm\}` `{!ln\}` `{!lr\}` `{!lč\}` `{!lǧ\}` `{!lw\}`
-`{!lh\}` `{!lf\}` `{!lj\}`
+`{!lta}` `{!lka}` `{!lga}` `{!lda}` `{!lƶa}` `{!lpa}` `{!lba}` `{!lsa}`
+`{!lla}` `{!lma}` `{!lna}` `{!lra}` `{!lča}` `{!lǧa}` `{!lwa}` `{!lha}`
+`{!lfa}` `{!lja}`
 :::
 
 ::: {.letter-list #conj-m}
-`{!mt\}` `{!mk\}` `{!mg\}` `{!md\}` `{!mƶ\}` `{!mp\}` `{!mb\}` `{!ms\}`
-`{!mš\}` `{!ml\}` `{!mm\}` `{!mn\}` `{!mr\}` `{!mč\}` `{!mǧ\}` `{!mw\}`
-`{!mh\}` `{!mf\}` `{!mj\}`
+`{!mta}` `{!mka}` `{!mga}` `{!mda}` `{!mƶa}` `{!mpa}` `{!mba}` `{!msa}`
+`{!mla}` `{!mma}` `{!mna}` `{!mra}` `{!mča}` `{!mǧa}` `{!mwa}` `{!mha}`
+`{!mfa}` `{!mja}`
 :::
 
 ::: {.letter-list #conj-n}
-`{!nt\}` `{!nk\}` `{!ng\}` `{!nd\}` `{!nƶ\}` `{!np\}` `{!nb\}` `{!ns\}`
-`{!nš\}` `{!nl\}` `{!nm\}` `{!nn\}` `{!nr\}` `{!nč\}` `{!nǧ\}` `{!nw\}`
-`{!nh\}` `{!nf\}` `{!nj\}`
+`{!nta}` `{!nka}` `{!nga}` `{!nda}` `{!nƶa}` `{!npa}` `{!nba}` `{!nsa}`
+`{!nla}` `{!nma}` `{!nna}` `{!nra}` `{!nča}` `{!nǧa}` `{!nwa}` `{!nha}`
+`{!nfa}` `{!nja}`
 :::
 
 ::: {.letter-list #conj-r}
-`{!rt\}` `{!rk\}` `{!rg\}` `{!rd\}` `{!rƶ\}` `{!rp\}` `{!rb\}` `{!rs\}`
-`{!rš\}` `{!rl\}` `{!rm\}` `{!rn\}` `{!rr\}` `{!rč\}` `{!rǧ\}` `{!rw\}`
-`{!rh\}` `{!rf\}` `{!rj\}`
+`{!rta}` `{!rka}` `{!rga}` `{!rda}` `{!rƶa}` `{!rpa}` `{!rba}` `{!rsa}`
+`{!rla}` `{!rma}` `{!rna}` `{!rra}` `{!rča}` `{!rǧa}` `{!rwa}` `{!rha}`
+`{!rfa}` `{!rja}`
 :::
 
 ::: {.letter-list #conj-o}
-`{!kk\}` `{!ks\}` `{!pp\}` `{!ps\}` `{!pj\}`
-`{!bj\}` `{!čs\}` `{!čč\}` `{!hh\}`
-`{!hn\}` `{!hm\}` `{!fn\}` `{!fm\}`
+`{!kka}` `{!ksa}` `{!ppa}` `{!psa}` `{!pja}`
+`{!bja}` `{!čsa}` `{!čča}` `{!hha}`
+`{!hna}` `{!hma}` `{!fna}` `{!fma}`
 :::
 
 If a word ends in a consnant, a horizontal line is drawn under it to specify

pages/zalajmkwely/index.md

@@ -1,6 +1,6 @@
 ---
 title: Zalajmkwély
-lang: zalajmkwely
+conlang: zalajmkwely
 ...
 
 # Phonology