sound-change (empty) → 0.1.0.0

raw patch · 8 files changed

+805/−0 lines, 8 filesdep +basedep +containersdep +hspec

Dependencies added: base, containers, hspec, megaparsec, mtl, parser-combinators, sound-change, syb, template-haskell

Files

• CHANGELOG.md +5/−0
• LICENSE +21/−0
• README.md +4/−0
• sound-change.cabal +81/−0
• src/Language/Change.hs +106/−0
• src/Language/Change/Quote.hs +401/−0
• test/Language/ChangeSpec.hs +186/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,5 @@+# Revision history for sound-change++## 0.1.0.0 -- 2023-10-13++* First version. Released on an unsuspecting world.

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2023 Owen Bechtel++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,4 @@+# sound-change+A sound change applier written in Haskell.++Documentation is available on [Hackage](https://hackage.haskell.org/package/sound-change).

@@ -0,0 +1,81 @@+cabal-version:      2.4+name:               sound-change+version:            0.1.0.0+author:             Owen Bechtel+maintainer:         ombspring@gmail.com++category:           Language, Linguistics+synopsis:           Apply sound changes to words++description:        +  Example usage:+  .+  @+  {-# LANGUAGE QuasiQuotes #-}+  import Language.Change (Change, applyChanges)+  import Language.Change.Quote+  .+  setV = "aeiou"+  .+  changes :: [Change Char]+  changes = [chs|+  &#x20; * { k > tʃ; g > dʒ } / _i+  &#x20; * i > e / _i+  &#x20;   u > o / _u+  &#x20; * { p > b; t > d } / V_{Vlr}+  &#x20; * a > e / _V!*i+  &#x20; |]+  .+  results = map (applyChanges changes) [ "kiis", "kapir", "atri" ]+  \-- [ "tʃeis", "kebir", "edri" ]+  @+  .+  See the module documentation for more information.++homepage:           https://github.com/UnaryPlus/sound-change+bug-reports:        https://github.com/UnaryPlus/sound-change/issues+license:            MIT+license-file:       LICENSE+extra-source-files: CHANGELOG.md, README.md++source-repository head+  type:     git+  location: https://github.com/UnaryPlus/sound-change.git++library+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall++  exposed-modules:+    Language.Change,+    Language.Change.Quote++  build-depends:+    base >= 4.9.0.0 && < 5,+    containers >= 0.2.0.0 && < 0.8,+    syb >= 0.1.0.0 && < 0.8,+    template-haskell >= 2.5.0.0 && < 2.22,+    megaparsec >= 9.0.0 && < 10,+    parser-combinators >= 0.4.0 && < 2,+    mtl >= 1.0 && < 2.4++test-suite test+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test +  default-language: Haskell2010+  ghc-options:      -Wall+  main-is:          Spec.hs++  other-modules: Language.ChangeSpec++  build-depends:+    base, hspec, containers, sound-change++  build-tool-depends:+    hspec-discover:hspec-discover+    ++++

@@ -0,0 +1,106 @@+{-|+Module     : Language.Change+Copyright  : (c) Owen Bechtel, 2023+License    : MIT+Maintainer : ombspring@gmail.com+Stability  : experimental+-}++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE BlockArguments #-}+module Language.Change+  ( -- * Phoneme sets+    PSet(..), member+    -- * Environments+  , Pattern(..), Env(..)+  , testPatterns, testEnv+    -- * Sound changes+  , Change(..)+  , applyChange, applyChanges, traceChanges, replace+  ) where++import qualified Data.Set as Set+import qualified Data.Map as Map+import Data.Set (Set)+import Data.Map (Map)+import Data.List (find, foldl', scanl')++-- | A finite set, or the complement of a finite set.+data PSet a = PSet (Set a) Bool+  deriving (Show)++-- | Test for membership in a 'PSet'.+--+-- @+-- member x (PSet set b) = 'Set.member' x set == b+-- @+member :: Ord a => a -> PSet a -> Bool+member x (PSet set b) = Set.member x set == b++-- | A single component of an 'Env'.+data Pattern a+  = One (PSet a)      -- ^ Matches one occurrence of a 'PSet' member.+  | Optional (PSet a) -- ^ Matches zero or one occurences of a 'PSet' member.+  | Many (PSet a)     -- ^ Matches zero or more occurences of a 'PSet' member.+  deriving (Show)++-- | An environment in which a phoneme (or in general, a value of type @a@), might occur.+-- An 'Env' is specified by two lists of patterns: the environment before the phoneme (ordered from nearest to farthest), and the environment after.+data Env a = Env [Pattern a] [Pattern a] +  deriving (Show)++-- | A sound change.+newtype Change a = Change (Map a [([a], Env a)])+  deriving (Show)++-- | Match a list of phonemes against a list of patterns.+testPatterns :: Ord a => [a] -> [Pattern a] -> Bool+testPatterns list = \case+  [] -> True++  One set : ps ->+    case list of+      x:xs | member x set -> testPatterns xs ps+      _ -> False++  Optional set : ps ->+       testPatterns list ps+    || testPatterns list (One set : ps)++  Many set : ps ->+      testPatterns list ps+    || testPatterns list (One set : Many set : ps)++-- | Match two lists of phonemes against an 'Env'.+testEnv :: Ord a => [a] -> [a] -> Env a -> Bool+testEnv left right (Env psL psR) =+  testPatterns left psL && testPatterns right psR++-- | A helper function used by 'applyChange'.+-- Similar to 'map', except the first argument returns a list and has access to each element's environment.+replace :: ([a] -> a -> [a] -> [b]) -> [a] -> [b]+replace f = replace' []+  where+    replace' _ [] = []+    replace' left (x:right) = f left x right ++ replace' (x:left) right++-- | Apply a sound change to a word.+applyChange :: Ord a => Change a -> [a] -> [a]+applyChange (Change mapping) =+  replace \left x right ->+    case Map.lookup x mapping of+      Nothing -> [x]+      Just cs ->+        case find (testEnv left right . snd) cs of+          Nothing -> [x]+          Just (x', _) -> x'++-- | Apply a sequence of sound changes to a word, returning the final result.+applyChanges :: Ord a => [Change a] -> [a] -> [a]+applyChanges cs x = foldl' (flip applyChange) x cs++-- | Apply a sequence of sound changes to a word, returning a list of intermediate results.+-- (The first element of the list is the original word, and the last element is the result after applying all changes.)+traceChanges :: Ord a => [Change a] -> [a] -> [[a]]+traceChanges cs x = scanl' (flip applyChange) x cs+

@@ -0,0 +1,401 @@+{-|+Module     : Language.Change.Quote+Copyright  : (c) Owen Bechtel, 2023+License    : MIT+Maintainer : ombspring@gmail.com+Stability  : experimental+-}++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TupleSections #-}+module Language.Change.Quote (ch, chs) where++import Data.Data (Data)+import Data.Void (Void)+import Data.List.NonEmpty (NonEmpty(..), toList, cons)+import Data.Char (isAlphaNum, isAsciiUpper, isSpace)+import Data.Bifunctor (first)+import Control.Monad (void)++import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Set (Set)++import qualified Text.Megaparsec as M+import Text.Megaparsec ((<|>))+import qualified Text.Megaparsec.Char as MC+import qualified Text.Megaparsec.Char.Lexer as Lexer+import qualified Control.Monad.Combinators.NonEmpty as NE++import Control.Monad.Reader (ReaderT(..), local)++import qualified Language.Haskell.TH as TH+import Language.Haskell.TH.Quote(QuasiQuoter(..), dataToExpQ)+import Language.Haskell.TH.Lib (appE, conE, varE)+import Data.Generics.Aliases (extQ)++import Language.Change (Change(..), Env(..), PSet(..), Pattern(..), applyChanges)++data CharS+  = Lit Char+  | AntiQ String -- antiquoted identifier+  | CList [Char] -- does not exist in syntax; used for compilation of antiquotes+  deriving (Data)++newtype SetS = SetS (NonEmpty CharS)+  deriving (Data)++data PSetS = PSetS SetS Bool+  deriving (Data)++data PatternS+  = OneS PSetS+  | OptionalS PSetS+  | ManyS PSetS+  deriving (Data)++data EnvS = EnvS [PatternS] [PatternS]+  deriving (Data)++type Pairing a b = NonEmpty (a, b)+type SoundList = NonEmpty CharS+type EnvList = NonEmpty EnvS+newtype Rep = Rep { convertRep :: String }+  deriving (Data)++data StatementS+  = Simple SoundList Rep EnvList+  | SoundSplit SoundList (Pairing Rep EnvList)+  | EnvSplit (Pairing SoundList Rep) EnvList +  deriving (Data)++newtype ChangeS = ChangeS (NonEmpty StatementS)+  deriving (Data)++type Parser = ReaderT Bool (M.Parsec Void String) -- True = allow newlines++allowNewlines :: Parser a -> Parser a+allowNewlines = local (const True)++isSound, isIdentifier :: Char -> Bool+isSound c = not (isSpace c || isAsciiUpper c || c `elem` ",>/;{}[]%_!?*")+isIdentifier c = isAlphaNum c || c == '_' || c == '\''++spaces :: Parser ()+spaces = ReaderT $ \allowNs ->+  Lexer.space (if allowNs then MC.space1 else MC.hspace1) lineComment M.empty+  where lineComment = Lexer.skipLineComment "//"++symbol :: Char -> Parser ()+symbol c = M.single c >> spaces++charS :: Parser CharS+charS = M.choice [ lit, oneChar, multipleChar ]+  where+    lit = Lit <$> M.satisfy isSound <* spaces++    oneChar = AntiQ . pure <$> M.satisfy isAsciiUpper <* spaces++    multipleChar = AntiQ+      <$ symbol '['+      <*> M.takeWhile1P (Just "Haskell identifier") isIdentifier+      <* spaces+      <* symbol ']'++setS :: Parser SetS+setS = M.choice+  [ SetS . pure <$> charS+  , SetS <$ symbol '{' <*> NE.some charS <* symbol '}'+  ]++pSetS :: Parser PSetS+pSetS = PSetS +  <$> setS +  <*> M.choice [ False <$ symbol '!', return True ]++patternS :: Parser PatternS+patternS = do+  pset <- pSetS+  M.choice+    [ OptionalS pset <$ symbol '?'+    , ManyS pset <$ symbol '*'+    , return (OneS pset)+    ]++envS :: Parser EnvS+envS = EnvS+  <$> (reverse <$> M.many patternS)+  <* symbol '_'+  <*> M.many patternS++pairing :: Parser a -> Parser () -> Parser b -> Parser (Pairing a b)+pairing pa psep pb = do+  allowNewlines (symbol '{')+  ps <- allowNewlines (NE.sepBy1 pair (symbol ';'))+  symbol '}'+  return ps+  where+    pair = (,) <$> pa <* psep <*> pb++soundList :: Parser SoundList+soundList = NE.sepBy1 charS (symbol ',')++envList :: Parser EnvList+envList = NE.sepBy1 envS (symbol ',')++rep :: Parser Rep+rep = M.choice+  [ Rep <$> M.takeWhile1P (Just "phoneme") isSound <* spaces+  , Rep "" <$ symbol '%'+  ]++statementS :: Parser StatementS+statementS = envSplit <|> other+  where+    envSplit = EnvSplit +      <$> pairing soundList (symbol '>') rep +      <* symbol '/' +      <*> envList+    +    other = do+      sounds <- soundList+      symbol '>'+      M.choice+        [ SoundSplit sounds <$> pairing rep (symbol '/') envList+        , Simple sounds <$> rep <* symbol '/' <*> envList+        ]++someNewlines :: Parser ()+someNewlines = void (M.some (symbol '\n' <|> symbol '\r'))++changeS :: Parser ChangeS+changeS = ChangeS <$> NE.sepEndBy1 statementS someNewlines++bulletedChanges :: Parser (NonEmpty ChangeS)+bulletedChanges = do+  symbol '*'+  stmt <- statementS+  newline <- M.option False (True <$ someNewlines)+  if newline +    then M.choice +      [ (ChangeS (stmt :| []) `cons`) <$> bulletedChanges+      , (\(stmts, cs) -> ChangeS (stmt `cons` stmts) :| cs) <$> nonBulleted+      , return (ChangeS (stmt :| []) :| [])+      ]+    else return (ChangeS (stmt :| []) :| [])++  where+    nonBulleted :: Parser (NonEmpty StatementS, [ChangeS])+    nonBulleted = do+      stmt <- statementS+      newline <- M.option False (True <$ someNewlines)+      if newline+        then M.choice+          [ (\cs -> (stmt :| [], toList cs)) <$> bulletedChanges+          , first (stmt `cons`) <$> nonBulleted+          , return (stmt :| [], [])+          ]+        else return (stmt :| [], [])++total :: Parser a -> Parser a+total p = allowNewlines spaces >> (p <* M.eof)++{-|+Compile a sound change specification into a value of type 'Change' 'Char'.++Example:++@+setV = "aeiou"++change1 = [ch|+  m, n, ŋ > { m \/ _{mpb}; n \/ _{ntd}; ŋ \/ _{ŋkg} }+  { p > b; t > d; k > g } \/ V_V+  |]+@++The sound change in this example consists of two statements separated by a newline. The first statement says +\"m, n, and ŋ become \/m\/ when followed by m, p, or b, \/n\/ when followed by n, t, or d, and \/ŋ\/ when followed by ŋ, k, or g.\"+The second statement says that voiceless stops (p, t, and k) become voiced when between two vowels. The uppercase @V@ here is+shorthand for \"any element of @setV@.\" ++All uppercase letters are interpreted in this way, which means they are not allowed as phonemes. +Whitespace characters, as well as the following symbols ( @,>\/;{}[]%_!?*@ ) are also not allowed as phonemes. +All other unicode characters are allowed. (For example, you can use @#@ as a \"phoneme\" representing the start or end of a word.)+ +Here's another example:++@+change2 = [ch|+  V > % \/ s_{ptk}             \/\/ vowel loss after \/s\/ before stops+  { o > ø; u > y } \/ _V!*{ji} \/\/ umlaut before \/j\/ and \/i\/ (with optional consonants in between) +  y > i \/ _                   \/\/ unconditional shift+ |]+@++This example illustrates several features:++* You can create line comments with @\/\/@. ++* The left side of @>@ need not be a single phoneme; it can also be a set of phonemes (in this case @V@).++* The symbol @%@ represents the empty string.++* Certain suffixes can be added to phonemes and phoneme-sets to create more complex patterns:++    * @X!@ matches anything /not/ in the set @X@.++    * @X*@ matches zero or more elements of @X@.++    * @X?@ matches zero or one elements of @X@.++    * There are also the combinations @X!*@ and @X!?@.++* To create an unconditional sound change, use the empty environment @_@.++* The statements in a sound change are applied in a single traversal.+This means that the same phoneme cannot be affected by more than one statement.+For example, the change above would convert \"yni\" into \"ini,\" and \"uni\" into \"yni.\"+(If you want to sequence multiple changes, use 'chs'.)++* If multiple statements are applicable to the same phoneme, the first one is applied.+For example, the change above would convert \"soki\" into \"ski\", not \"søki.\"++Other noteworthy things:++* As mentioned above, capital letters refer to sets of characters: @V@ refers to @setV@, @N@ refers to @setN@, and so on.+To refer to sets with longer names, you can use square brackets; +for example, if you define @setNasal :: [Char]@, you can refer to it with @[Nasal]@.++* It is possible to have multiple conditions in a single statement. For example, @e > i / _a, a_@ means \"\/e\/ becomes \/i\/ when before \/a\/ /or/ after \/a\/.\" ++* The parser is whitespace-sensitive. Horizontal space characters can go almost anywhere, +but newlines are only allowed between statements (where they are required)+and inside of @{}@ blocks.+-}++ch :: QuasiQuoter+ch = QuasiQuoter +  { quoteExp = makeQuoter (total changeS) (varE 'convertChangeS)+  , quotePat = undefined +  , quoteType = undefined+  , quoteDec = undefined +  }++{-|+Compile a sequence of sound changes into a value of type @['Change' 'Char']@.+Each change is preceded by a bullet @*@. For example:++@+changes = [chs|+  * p > f \/ _{tk}+    t > θ \/ _{pk}+    k > x \/ _{pt} \/\/ these three statements are applied in a single traversal+  * x > ç \/ i_    \/\/ this statement is applied after the ones before it+  * i > j \/ _V+  |]+@++For example, @'applyChanges' changes "ikt"@ would return @"içt"@.+-}++chs :: QuasiQuoter+chs = QuasiQuoter +  { quoteExp = makeQuoter (toList <$> total bulletedChanges) (appE (varE 'map) (varE 'convertChangeS))+  , quotePat = undefined +  , quoteType = undefined+  , quoteDec = undefined +  }+  +initialState :: s -> M.SourcePos -> M.State s Void+initialState input position =+  M.State+    { M.stateInput = input+    , M.stateOffset = 0+    , M.statePosState =+        M.PosState+          { M.pstateInput = input+          , M.pstateOffset = 0+          , M.pstateSourcePos = position+          , M.pstateTabWidth = M.defaultTabWidth+          , M.pstateLinePrefix = ""+          }+    , M.stateParseErrors = []+    }++makeQuoter :: (Data a) => Parser a -> TH.ExpQ -> String -> TH.ExpQ+makeQuoter parse convert input = do+  loc <- TH.location+  let file = TH.loc_filename loc+      (line, col) = TH.loc_start loc+      state = initialState input (M.SourcePos file (M.mkPos line) (M.mkPos col))+  +  case snd (M.runParser' (runReaderT parse False) state) of+    Left errors -> fail (M.errorBundlePretty errors)+    Right change -> +      let change' = dataToExpQ (const Nothing `extQ` antiquote) change+      in appE convert change'++antiquote :: CharS -> Maybe TH.ExpQ+antiquote = \case+  Lit _ -> Nothing+  AntiQ s -> Just (appE (conE 'CList) (varE (TH.mkName ("set" ++ s))))+  CList _ -> Nothing  ++badAntiQ :: a+badAntiQ = error "Language.Change.Quote: Unexpected AntiQ at runtime.\nThis error should never happen."++convertCharList :: CharS -> [Char]+convertCharList = \case+  Lit c -> [c]+  AntiQ _ -> badAntiQ+  CList cs -> cs++convertCharSet :: CharS -> Set Char+convertCharSet = \case+  Lit c -> Set.singleton c+  AntiQ _ -> badAntiQ +  CList cs -> Set.fromList cs++convertSetS :: SetS -> Set Char+convertSetS (SetS cs) = foldMap convertCharSet cs++convertPSetS :: PSetS -> PSet Char+convertPSetS (PSetS set b) = PSet (convertSetS set) b ++convertPatternS :: PatternS -> Pattern Char+convertPatternS = \case+  OneS set -> One (convertPSetS set)+  OptionalS set -> Optional (convertPSetS set)+  ManyS set -> Many (convertPSetS set)++convertEnvS :: EnvS -> Env Char+convertEnvS (EnvS e1 e2) = Env (map convertPatternS e1) (map convertPatternS e2)++convertEnvPair :: (Rep, EnvList) -> [(String, Env Char)]+convertEnvPair (rp, envs) =+  let rp' = convertRep rp+  in map (\env -> (rp', convertEnvS env)) (toList envs)++convertStatementS :: StatementS -> [(Char, [(String, Env Char)])]+convertStatementS = \case+  Simple sounds rp envs ->+    let pairs = convertEnvPair (rp, envs) +    in map (, pairs) (concatMap convertCharList sounds)++  SoundSplit sounds envPairs -> +    let pairs = concatMap convertEnvPair envPairs +    in map (, pairs) (concatMap convertCharList sounds)+    +  EnvSplit soundPairs envs ->+    let envs' = map convertEnvS (toList envs)+    in concatMap (\(sounds, rp) -> +          let rp' = convertRep rp+              pairs = map (rp', ) envs'+          in map (, pairs) (concatMap convertCharList sounds))+        soundPairs++convertChangeS :: ChangeS -> Change Char+convertChangeS (ChangeS stmts) = Change (Map.fromListWith (flip (++)) (concatMap convertStatementS stmts))

@@ -0,0 +1,186 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QuasiQuotes #-}+module Language.ChangeSpec where++import Test.Hspec (Spec, it, describe, shouldBe)++import qualified Data.Set as Set+import Data.Set (Set)++import Language.Change+  ( PSet(..), member+  , Pattern(..), Env(..)+  , testPatterns, testEnv, replace+  , applyChange, applyChanges, traceChanges+  )++import Language.Change.Quote (ch, chs)++import Debug.Trace++spec :: Spec+spec = do+  describe "Language.Change.member" do+    it "works on finite sets" do+      let set = PSet (Set.fromList [ 1, 5, 2 :: Int ]) True+      member 0 set `shouldBe` False+      member 4 set `shouldBe` False+      member 5 set `shouldBe` True+      member 2 set `shouldBe` True++    it "works on complements of sets" do+      let set = PSet (Set.fromList "xkcd") False+      member 'a' set `shouldBe` True+      member 'w' set `shouldBe` True+      member 'x' set `shouldBe` False+      member 'c' set `shouldBe` False ++    it "works on the empty set" do+      let set = PSet Set.empty True+      member 'a' set `shouldBe` False+      member 'z' set `shouldBe` False++    it "works on the universal set" do+      let set = PSet (Set.empty :: Set Int) False+      member 1 set `shouldBe` True+      member 9999999999999 set `shouldBe` True++  describe "Language.Change.testPatterns" do+    it "tests patterns properly" do+      let pats = +            [ Many (PSet (Set.fromList "ab") True)+            , Optional (PSet (Set.fromList "c") True)+            , One (PSet (Set.fromList "abc") False)+            ]+      testPatterns "" pats `shouldBe` False+      testPatterns "de" pats `shouldBe` True+      testPatterns "abbbaaaabacx" pats `shouldBe` True+      testPatterns "ab" pats `shouldBe` False+      testPatterns "aaar" pats `shouldBe` True+      +  describe "Language.Change.testEnv" do+    it "tests environments properly" do+      let env = Env+            [ Many (PSet (Set.fromList "a") True) ]+            [ One (PSet (Set.fromList "r") True)+            , Optional (PSet (Set.fromList "x") True) +            , One (PSet (Set.fromList "x") False)]+      testEnv "" "rr" env `shouldBe` True+      testEnv "aaa" "r" env `shouldBe` False+      testEnv "b" "rxa" env `shouldBe` True+      testEnv "aa" "rxx" env `shouldBe` False+  +  describe "Language.Change.replace" do+    it "replaces elements with lists" do+      let f [] _ _ = []+          f (l:_) x rs = map (\r -> r * x + l) rs +      replace f [ 1, 3, 5, 4, 2 :: Int ] `shouldBe` [ 16, 13, 7, 23, 13, 13 ]++  let setV = "aeiou"+  let setN = "mnŋ"++  describe "Language.Change.applyChange, Language.Change.Quote.ch" do+    it "applies simple changes" do+      let change1 = [ch| i > e / _i, k_ |]+      applyChange change1 "iiiii" `shouldBe` "eeeei"+      applyChange change1 "isiisi" `shouldBe` "iseisi"+      applyChange change1 "kiriitia" `shouldBe` "kereitia"++      let change2 = [ch| o > u / _V!*{ei} |]+      applyChange change2 "oi" `shouldBe` "ui"+      applyChange change2 "oki" `shouldBe` "uki"+      applyChange change2 "toronsti" `shouldBe` "torunsti"+    +    it "ignores spaces and allows comments" do+      let change1 = [ch| +        // originally [ʏ], later [u]+        o>u/_ V ! * { e i } +        |]+      applyChange change1 "oi" `shouldBe` "ui"+      applyChange change1 "oki" `shouldBe` "uki"+      applyChange change1 "toronsti" `shouldBe` "torunsti"++    it "applies env-split changes" do+      let change1 = [ch| { a > h; b > el; c, d > lo } / _ |]+      applyChange change1 "abc abd" `shouldBe` "hello hello"+    +    it "applies sound-split changes" do+      let change1 = [ch| a > { e / _{in}; o / _u, g_ } |]+      applyChange change1 "ga" `shouldBe` "go"+      applyChange change1 "tan" `shouldBe` "ten"+      applyChange change1 "gai" `shouldBe` "gei"+      applyChange change1 "aitaugavansarua" `shouldBe` "eitougovensarua"+    +    it "applies compound changes" do+      let change1 = [ch| +        m, n, ŋ > { m / _{mpb}; n / _{ntd}; ŋ / _{ŋkg} }+        { p > b; t > d; k > g } / V_V+        |]+      applyChange change1 "atanpa" `shouldBe` "adampa"+      applyChange change1 "tapeŋbak" `shouldBe` "tabembak"+    +    it "allows antiquotes before >" do+      let change1 = [ch| N > { m / _{mpb}; n / _{ntd}; ŋ / _{ŋkg} } |]+      applyChange change1 "anpa" `shouldBe` "ampa"+      applyChange change1 "aŋtim" `shouldBe` "antim"+    +    it "parses environments in the correct order" do+      let change1 = [ch| +        t > to / arc_ic+        c > dea / cti_+        |]+      applyChange change1 "arctic" `shouldBe` "arctoidea"+    +    it "works for the example in the documentation" do+      let change1 = [ch|+        V > % / s_{ptk}             // vowel loss after /s/ before stops+        { o > ø; u > y } / _V!*{ji} // umlaut before /j/ and /i/ (with optional consonants in between) +        y > i / _                   // unconditional shift               +        |]++      traceShowM change1+      applyChange change1 "uni" `shouldBe` "yni"+      applyChange change1 "yni" `shouldBe` "ini"+      applyChange change1 "esoki" `shouldBe` "eski"+  +  describe "Language.Change.applyChanges, Language.Change.Quote.chs" do+    it "applies a sequence of changes (1)" do+      let changes = [chs|+        * o > u / _V!*{ei}+        * s > ʃ / _{iu}+        * u > o / _V+        * { t > d; s > z; ʃ > ʒ } / V_V+        |]++      applyChanges changes "soi" `shouldBe` "ʃoi"+      applyChanges changes "asorti" `shouldBe` "aʒurti"+      applyChanges changes "tsita" `shouldBe` "tʃida"+    +    it "applies a sequence of changes (2)" do+      let changes = [chs|+        * s > ʃ / _k{ei}+          k > % / s_{ei}+        * a > e / _ʃ+        * o > a / _u+        |]+      +      applyChanges changes "ski" `shouldBe` "ʃi"+      applyChanges changes "taski" `shouldBe` "teʃi"+      applyChanges changes "skouske" `shouldBe` "skauʃe"+  +  describe "Language.Change.traceChanges, Language.Change.Quote.chs" do+    it "returns a list of intermediate results" do+      let changes = [chs|+        * o > u / _V!*{ei}+        * s > ʃ / _{iu}+        * u > o / _V+        * { t > d; s > z; ʃ > ʒ } / V_V+        |]++      traceChanges changes "soi" `shouldBe` [ "soi", "sui", "ʃui", "ʃoi", "ʃoi" ]+      traceChanges changes "asorti" `shouldBe` [ "asorti", "asurti", "aʃurti", "aʃurti", "aʒurti" ] +      traceChanges changes "tsita" `shouldBe` [ "tsita", "tsita", "tʃita", "tʃita", "tʃida" ]+      traceChanges changes "na" `shouldBe` replicate 5 "na" ++  +

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}