Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

All of the Jbobaf functions in Vlatai.hs now use a custom error type …

…in place

of Strings
  • Loading branch information...
commit 06559154a570c0b15340dcd74331d008d6174f26 1 parent cd6413e
John T. Wodder II jwodder authored
11 haskell/Jbobaf/Canti.hs
@@ -60,12 +60,11 @@ module Jbobaf.Canti where
60 60 where (c, r) = span isC str
61 61 (v, rest) = span isVy r
62 62
  63 + -- |Tests whether a syllable contains a non-Y vowel and is thus vocalic
63 64 voc :: String -> Bool
64   - -- Tests whether a syllable contains a non-Y vowel and is thus accentable.
65   - -- The short name is solely for aesthetic reasons.
66   - voc = not . null . filter isV
  65 + voc = any isV
67 66
  67 + -- |Checks for the presence of a non-initial valid consonant pair
68 68 has_C_C :: String -> Bool
69   - -- checks for the presence of a non-initial valid consonant pair
70   - has_C_C str = not $ null $ filter (\i -> let cc = take 2 $ drop i str
71   - in isC_C cc && not (isCC cc)) (findIndices isC str)
  69 + has_C_C str = any (\i -> let cc = take 2 $ drop i str
  70 + in isC_C cc && not (isCC cc)) $ findIndices isC str
102 haskell/Jbobaf/Jitro.hs
... ... @@ -1,4 +1,5 @@
1   --- |Run-time configuration options and a Reader monad for keeping track of them
  1 +-- |Run-time configuration options and a combined Reader-Error monad for
  2 +-- keeping track of them
2 3
3 4 module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
4 5 where
@@ -7,9 +8,10 @@ module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
7 8 import Control.Monad.Error
8 9 import Control.Monad.Reader
9 10
10   - type Jvacux a = ReaderT (Set Tercuxna) (Either String) a
  11 + type JvacuxT m a = ReaderT (Set Tercuxna) m a
  12 + type Jvacux a = ReaderT (Set Tercuxna) (Either Selsrera) a
11 13
12   - isOpt, isNopt :: Monad m => Tercuxna -> ReaderT (Set Tercuxna) m Bool
  14 + isOpt, isNopt :: Monad m => Tercuxna -> JvacuxT m Bool
13 15 isOpt = asks . member
14 16 isNopt = asks . notMember
15 17
@@ -17,14 +19,18 @@ module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
17 19 xusnada m = (m >> return True) `mplus` return False
18 20
19 21 nupre :: Jvacux a -> Set Tercuxna -> a
20   - nupre jct opts = either error id $ runReaderT jct opts
  22 + nupre jct opts = either (error . show) id $ runReaderT jct opts
  23 + -- Flesh out this ^^^ later!!!
21 24
22   - -- Are these two functions necessary and/or useful?
  25 + -- Are the following three functions necessary and/or useful?
23 26
24   - fliba :: String -> Jvacux a
  27 + fliba :: Selsrera -> Jvacux a
25 28 fliba = throwError
26 29
27   - kavbu :: Jvacux a -> (String -> Jvacux a) -> Jvacux a
  30 + fliba' :: String -> Jvacux a
  31 + fliba' = throwError . strMsg
  32 +
  33 + kavbu :: Jvacux a -> (Selsrera -> Jvacux a) -> Jvacux a
28 34 kavbu = catchError
29 35
30 36 data Tercuxna =
@@ -96,3 +102,85 @@ module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
96 102 defaults = fromList [Use_dotside, Allow_accents, Ignore_naljbo_chars,
97 103 Allow_triphthongs, Allow_H, Allow_ndj_in_fu'ivla, Allow_ndj_in_cmevla,
98 104 No_commas_in_cmavo, Translate_digits, Split_bad_diphthongs]
  105 +
  106 + data Srelei =
  107 + SRE_internal_error -- something that is not supposed to happen
  108 + | SRE_invalid_word_form -- generic morphological failure
  109 + | SRE_empty_string
  110 + | SRE_invalid_emphasis
  111 + | SRE_bad_consonant_pair
  112 + | SRE_bad_consonant_triple
  113 + | SRE_tosmabru_failure
  114 + | SRE_slinku'i_failure
  115 + | SRE_bad_vowel_sequence -- bad diphthong, triphthong, etc.
  116 + | SRE_no_spaces_allowed -- internal spaces/periods not allowed
  117 + | SRE_lacks_cluster -- consonant cluster absent from {fu'ivla}
  118 + | SRE_non_Lojban_char -- non-Lojbanic character in string
  119 + | SRE_misplaced_apostrophe
  120 + | SRE_no_commas_allowed
  121 + | SRE_no_Ys_allowed -- applies only to {fu'ivla}?
  122 + | SRE_na'e_fu'ivla -- proposed {fu'ivla} is actually a {gismu} or {lujvo}
  123 + | SRE_bad_rn_hyphen -- includes superfluous r/n-hyphens
  124 + | SRE_missing_rn_hyphen
  125 + | SRE_too_much_before_cluster
  126 + -- two many letters or {ma'osmi} before a consonant cluster in a {brivla}
  127 + | SRE_extra_Y_hyphen
  128 + -- sre_valsi !! 2 == the normalized portion of the {lujvo} up through the Y
  129 + -- sre_valsi !! 3 == the normalized portion of the {lujvo} after the Y
  130 + | SRE_invalid_rafsi
  131 + -- sre_valsi !! 2 == the {lujvo} up through the end of the bad {rafsi}
  132 + -- sre_valsi !! 3 == the {lujvo} after the bad {rafsi}
  133 + | SRE_la_in_cmevla -- when the dotside is not in effect
  134 + | SRE_not_enough_rafsi
  135 + | SRE_not_enough_syllables -- vocalic syllables, that is
  136 + | SRE_must_end_with_vowel
  137 + | SRE_must_end_with_consonant
  138 + | SRE_breaks_apart -- into smaller words
  139 + | SRE_non_initial_start -- begins with non-initial consonant cluster
  140 + | SRE_consonant_inside_cmavo -- includes single consonants as {cmavo}
  141 + | SRE_other_error
  142 + deriving (Eq, Ord, Read, Show, Bounded, Enum, Ix)
  143 +
  144 + data Selsrera = Selsrera {
  145 + sre_velski :: [String],
  146 + -- description of the error; first element is usually the name of the
  147 + -- function that threw it, second element (if present) is the erroneous
  148 + -- argument to the function, third element (if present) is the problematic
  149 + -- substring of the second element
  150 + sre_klesi :: Srelei
  151 + } deriving (Eq, Ord, Read, Show)
  152 +
  153 + instance Error Selsrera where
  154 + noMsg = Selsrera ["noMsg"] SRE_other_error
  155 + strMsg s = Selsrera ["strMsg", s] SRE_other_error
  156 +
  157 +{-
  158 + Error messages:
  159 + - SRE_na'e_fu'ivla - "{fu'ivla} may not be {gismu} or {lujvo}."
  160 + - SRE_no_spaces_allowed - "{valsi} may not have internal spaces or periods."
  161 + - SRE_must_end_with_vowel - "{brivla} must end with a vowel."
  162 + - SRE_no_Ys_allowed - "{fu'ivla} may not contain Y's."
  163 + - SRE_not_enough_syllables - "{brivla} must contain two or more vocalic syllables."
  164 + - SRE_non_initial_start - "Non-initial consonant clusters may not occur at the start of a {fu'ivla}."
  165 + - SRE_too_much_before_cluster - "The consonant cluster in a {fu'ivla} may be preceded by no more than three letters."
  166 + - "A consonant cluster in a {fu'ivla} must be preceded by no more than one {ma'osmi}."
  167 + - SRE_breaks_apart - "{fu'ivla} may not break apart into smaller words."
  168 + - SRE_lacks_cluster - "{fu'ivla} must contain a consonant cluster."
  169 + - SRE_must_end_with_consonant - "{cmevla} must end with a consonant."
  170 + - SRE_la_in_cmevla - "{cmevla} may not contain the strings \"la\", \"lai\", \"la'i\", or \"doi\"."
  171 + - SRE_consonant_inside_cmavo - "{cmavo} may not have internal spaces, periods, or consonants."
  172 + - SRE_non_Lojban_char - "Non-Lojbanic character in string"
  173 + - SRE_misplaced_apostrophe - "Apostrophe next to a non-vowel detected."
  174 + - "Apostrophes may not occur at the end of a string."
  175 + - "Apostrophes may not occur at the beginning of a string."
  176 + - SRE_bad_vowel_sequence - "Invalid diphthong detected"
  177 + - "Invalid 4-vowel sequence detected"
  178 + - "Invalid triphthong detected"
  179 + - SRE_not_enough_rafsi - "{lujvo} must contain at least two {rafsi}."
  180 + - SRE_extra_Y_hyphen - "Superfluous Y-hyphen in {lujvo}"
  181 + - SRE_bad_rn_hyphen - "Invalid r/n-hyphen in {lujvo}"
  182 + - SRE_missing_rn_hyphen - "R/n-hyphen missing from {lujvo}"
  183 + - SRE_invalid_rafsi - "Invalid {rafsi} form"
  184 + - SRE_tosmabru_failure - "{lujvo} missing tosmabru hyphen"
  185 + - SRE_invalid_emphasis - "Invalid {brivla} emphasis"
  186 +-}
238 haskell/Jbobaf/Vlatai.hs
@@ -19,7 +19,7 @@ module Jbobaf.Vlatai (
19 19 import Char
20 20 import Ix
21 21 import List (findIndices)
22   - import Monad (mplus)
  22 + import Monad (mplus, when, unless)
23 23 import qualified Data.Set as Set
24 24 import Jbobaf.Canti
25 25 import Jbobaf.Jitro
@@ -76,53 +76,53 @@ module Jbobaf.Vlatai (
76 76 brivla_xusra' str = gismu_xusra' str
77 77 `mplus` lujvo_xusra' str
78 78 `mplus` fu'ivla_xusra' str
79   - `mplus` throwError "This string is not a {brivla}."
80   -
  79 + `mplus` throwError (Selsrera ["brivla_xusra", str] SRE_invalid_word_form)
  80 +
81 81 gismu_xusra, gismu_xusra' :: String -> Jvacux ()
82 82 gismu_xusra str = fadgau str >>= gismu_xusra'
83   - gismu_xusra' [a, b, c, d, e] = do
  83 + gismu_xusra' [] = throwError $ Selsrera ["gismu_xusra"] SRE_empty_string
  84 + gismu_xusra' s@[a, b, c, d, e] = do
84 85 noemph <- isOpt Ignore_brivla_emphasis
85   - xusra (isC a && isC d && isV e && (isV b && isC c && isC_C [c, d]
86   - || isC b && isV c && isCC [a, b])) "Invalid {gismu} form"
87   - xusra (noemph || not (isUpper e)) "Invalid {brivla} emphasis"
88   - gismu_xusra' _ = throwError "{gismu} must be five letterals long."
  86 + unless (isC a && isC d && isV e && (isV b && isC c && isC_C [c, d]
  87 + || isC b && isV c && isCC [a, b]))
  88 + (throwError $ Selsrera ["gismu_xusra", s] SRE_invalid_word_form)
  89 + when (not noemph && isUpper e) (throwError $ Selsrera ["gismu_xusra", s]
  90 + SRE_invalid_emphasis)
  91 + gismu_xusra' s = throwError $ Selsrera ["gismu_xusra", s] SRE_invalid_word_form
89 92
90 93 lujvo_xusra, lujvo_xusra' :: String -> Jvacux ()
91 94 lujvo_xusra str = fadgau str >>= lujvo_xusra'
92 95 lujvo_xusra' str = do
93 96 noemph <- isOpt Ignore_brivla_emphasis
94 97 let sylls = syllabicate str
95   - emphQty = length $ filter (not . null . filter isUpper) sylls
  98 + emphQty = length $ filter (any isUpper) sylls
96 99 jvokatna' str
97   - xusra (noemph || emphQty == 0 || emphQty == 1
98   - && not (null $ filter isUpper $ last $ init $ filter voc sylls))
99   - "Invalid {brivla} emphasis"
  100 + unless (noemph || emphQty == 0 || emphQty == 1 && any isUpper (last $ init
  101 + $ filter voc sylls)) (throwError $ Selsrera ["lujvo_xusra", str]
  102 + SRE_invalid_emphasis)
100 103
101 104 fu'ivla_xusra, fu'ivla_xusra' :: String -> Jvacux ()
102 105 fu'ivla_xusra str = fadgau str >>= fu'ivla_xusra'
  106 + fu'ivla_xusra' [] = throwError $ Selsrera ["fu'ivla_xusra"] SRE_empty_string
103 107 fu'ivla_xusra' str = do
104 108 noemph <- isOpt Ignore_brivla_emphasis
105 109 canY <- isOpt Allow_Y_in_fu'ivla
106 110 ndj <- isOpt Allow_ndj_in_fu'ivla
107 111 let vocSyls = filter voc $ syllabicate str
108   - emphQty = length $ filter (not . null . filter isUpper) vocSyls
109   - xusra (not $ null str) "{fu'ivla} must be non-empty."
110   - xugismu' str >>= flip xusra "{fu'ivla} may not be {gismu}." . not
111   - xulujvo' str >>= flip xusra "{fu'ivla} may not be {lujvo}." . not
112   - if isC (head str) then (xulujvo' $ 't':'o':str)
113   - >>= flip xusra "{fu'ivla} may not fail the tosmabru test" . not
114   - else return ()
115   - xusra (notElem ' ' str) "{fu'ivla} may not have internal spaces or periods."
116   - xusra (isV $ last str) "{fu'ivla} must end with a vowel."
117   - xusra (noBadCC str) "{fu'ivla} may not contain any invalid consonant pairs."
118   - xusra (ndj || not (hasNDJ str)) "{fu'ivla} may not contain the strings\
119   - \ \"ndj\", \"ndz\", \"ntc\", or \"nts\"."
120   - xusra (canY || notElem 'y' str) "{fu'ivla} may not contain Y's."
121   - xusra (length vocSyls >= 2)
122   - "{fu'ivla} must contain two or more vocalic syllables."
123   - xusra (noemph || emphQty == 0 || emphQty == 1
124   - && not (null $ filter isUpper $ last $ init vocSyls))
125   - "Invalid {brivla} emphasis"
  112 + emphQty = length $ filter (any isUpper) vocSyls
  113 + sregau = throwError . Selsrera ["fu'ivla_xusra", str]
  114 + xugismu' str >>= flip when (sregau SRE_na'e_fu'ivla)
  115 + xulujvo' str >>= flip when (sregau SRE_na'e_fu'ivla)
  116 + when (isC $ head str)
  117 + $ xulujvo' ('t':'o':str) >>= flip when (sregau SRE_slinku'i_failure)
  118 + when (elem ' ' str) (sregau SRE_no_spaces_allowed)
  119 + unless (isV $ last str) (sregau SRE_must_end_with_vowel)
  120 + noBadCC "fu'ivla_xusra" str
  121 + unless ndj $ hasNDJ "fu'ivla_xusra" str
  122 + unless (canY || notElem 'y' str) (sregau SRE_no_Ys_allowed)
  123 + when (length vocSyls < 2) (sregau SRE_not_enough_syllables)
  124 + unless (noemph || emphQty == 0 || emphQty == 1 && any isUpper (last
  125 + $ init vocSyls)) (sregau SRE_invalid_emphasis)
126 126 case findC_C str of
127 127 Just ccLoc -> do
128 128 let (clust, rest) = span (\c -> isC c || c == 'y') (drop ccLoc str)
@@ -133,41 +133,41 @@ module Jbobaf.Vlatai (
133 133 || length (filter voc $ syllabicate rest) == 1
134 134 || ccLoc /= 0 && slinky
135 135 then do
136   - xusra (ccLoc /= 0) "Non-initial consonant clusters may not occur at the\
137   - \ start of a {fu'ivla}."
138   - xusra (length (filter (`notElem` "',y") preclust) <= 3) "The consonant\
139   - \ cluster in a {fu'ivla} may be preceded by no more than three letters."
140   - xusra (preCs == 1 && isC (head preclust) || preCs == 0) "A consonant\
141   - \ cluster in a {fu'ivla} must be preceded by no more than one {ma'osmi}."
142   - else xusra (ccLoc == 0) "{fu'ivla} may not break apart into smaller words."
143   - Nothing -> throwError "{fu'ivla} must contain a consonant cluster."
  136 + when (ccLoc == 0) (sregau SRE_non_initial_start)
  137 + unless (length (filter (`notElem` "',y") preclust) <= 3)
  138 + (sregau SRE_too_much_before_cluster)
  139 + unless (preCs == 1 && isC (head preclust) || preCs == 0)
  140 + (sregau SRE_too_much_before_cluster)
  141 + else unless (ccLoc == 0) (sregau SRE_breaks_apart)
  142 + Nothing -> sregau SRE_lacks_cluster
144 143
145 144 cmevla_xusra, cmevla_xusra' :: String -> Jvacux ()
146 145 cmevla_xusra str = fadgau str >>= cmevla_xusra'
147   - cmevla_xusra' [] = throwError "{cmevla} must be non-empty."
  146 + cmevla_xusra' [] = throwError $ Selsrera ["cmevla_xusra"] SRE_empty_string
148 147 cmevla_xusra' str = do
149 148 dotty <- isOpt Use_dotside
150 149 ndj <- isOpt Allow_ndj_in_cmevla
151   - xusra (isC $ last str) "{cmevla} must end with a consonant."
152   - xusra (notElem ' ' str) "{cmevla} may not have internal spaces or periods."
153   - xusra (noBadCC str) "{cmevla} may not contain any invalid consonant pairs."
154   - case (dotty, findLa str, ndj, hasNDJ str) of
155   - (False, Just _, _, _) -> throwError "{cmevla} may not contain the strings\
156   - \ \"la\", \"lai\", \"la'i\", or \"doi\"."
157   - (_, _, False, True) -> throwError "{cmevla} may not contain the strings\
158   - \ \"ndj\", \"ndz\", \"ntc\", or \"nts\"."
159   - _ -> return ()
  150 + let sregau = throwError . Selsrera ["cmevla_xusra", str]
  151 + unless (isC $ last str) (sregau SRE_must_end_with_consonant)
  152 + when (elem ' ' str) (sregau SRE_no_spaces_allowed)
  153 + noBadCC "cmevla_xusra" str
  154 + unless ndj $ hasNDJ "cmevla_xusra" str
  155 + unless dotty (case findLa str of
  156 + Just (_, la, _) -> throwError $ Selsrera ["cmevla_xusra", str, la]
  157 + SRE_la_in_cmevla
  158 + Nothing -> return ())
160 159
161 160 cmavo_xusra, cmavo_xusra' :: String -> Jvacux ()
162 161 cmavo_xusra str = fadgau str >>= cmavo_xusra'
163   - cmavo_xusra' [] = throwError "{cmavo} must be non-empty."
  162 + cmavo_xusra' [] = throwError $ Selsrera ["cmavo_xusra"] SRE_empty_string
164 163 cmavo_xusra' str@(c:xs) = do
165 164 commas <- isNopt No_commas_in_cmavo
166 165 let maho = if isC c then xs else str
167   - xusra (not $ null maho) "A single consonant is not a {cmavo}."
168   - xusra (null $ filter (\c -> isSpace c || isC c) maho)
169   - "{cmavo} may not have internal spaces, periods, or consonants."
170   - xusra (commas || notElem ',' maho) "{cmavo} may not contain commas."
  166 + sregau = throwError . Selsrera ["cmavo_xusra", str]
  167 + when (elem ' ' str) (sregau SRE_no_spaces_allowed)
  168 + when (null maho) (sregau SRE_consonant_inside_cmavo)
  169 + when (any isC maho) (sregau SRE_consonant_inside_cmavo)
  170 + unless (commas || notElem ',' maho) (sregau SRE_no_commas_allowed)
171 171
172 172 -- |@fadgau@ is a basic \"cleanup\" routine used by various functions in
173 173 -- Jbobaf for converting Lojban text into a more regular, \"normalized\" form.
@@ -225,7 +225,7 @@ module Jbobaf.Vlatai (
225 225 lerfad (c:xs) | isSpace c = ' ' ~: lerfad xs
226 226 lerfad (c:xs) | not (goodchr c) =
227 227 if ignoring then lerfad xs
228   - else throwError "Non-Lojbanic character in string"
  228 + else throwError $ Selsrera ["fadgau", str, [c]] SRE_non_Lojban_char
229 229 lerfad ('.':xs) = ' ' ~: lerfad xs
230 230 lerfad ('á':xs) = 'A' ~: lerfad xs
231 231 lerfad ('Á':xs) = 'A' ~: lerfad xs
@@ -264,11 +264,11 @@ module Jbobaf.Vlatai (
264 264 porfad (c:',':xs) | not (isVy c) = porfad (c:xs)
265 265 porfad (',':c:xs) | not (isVy c) = porfad (c:xs)
266 266 porfad ('\'':'\'':xs) = porfad ('\'':xs)
267   - porfad (c:'\'':xs)
268   - | not (isVy c) = throwError "Apostrophe next to a non-vowel detected."
269   - porfad ('\'':c:xs)
270   - | not (isVy c) = throwError "Apostrophe next to a non-vowel detected."
271   - porfad "'"= throwError "Apostrophes may not occur at the end of a string."
  267 + porfad (c:'\'':xs) | not (isVy c) =
  268 + throwError $ Selsrera ["fadgau", str, [c, '\'']] SRE_misplaced_apostrophe
  269 + porfad ('\'':c:xs) | not (isVy c) =
  270 + throwError $ Selsrera ["fadgau", str, ['\'', c]] SRE_misplaced_apostrophe
  271 + porfad "'"= throwError $ Selsrera ["fadgau", str] SRE_misplaced_apostrophe
272 272 porfad "," = return []
273 273 porfad " " = return []
274 274 porfad (' ':' ':xs) = porfad (' ':xs)
@@ -281,30 +281,36 @@ module Jbobaf.Vlatai (
281 281 vokfed [v] = return [v]
282 282 vokfed [v1, v2] = if isDiphth v1 v2 then return [v1, v2]
283 283 else if splitDiphth then return [v1, ',', v2]
284   - else throwError "Invalid diphthong detected"
285   - vokfed (v1:v2:v3:xs) =
  284 + else throwError $ Selsrera ["fadgau", str, [v1, v2]]
  285 + SRE_bad_vowel_sequence
  286 + vokfed vs@(v1:v2:v3:xs) =
286 287 if triphth && v1 `elem` "iuIU" && isDiphth v2 v3
287 288 then return [v1, v2, v3] ~~ (null xs ?: return [] :? splitDiphth
288   - ?: ',' ~: vokfed xs :? throwError "Invalid 4-vowel sequence detected")
  289 + ?: ',' ~: vokfed xs
  290 + :? throwError (Selsrera ["fadgau", str, vs] SRE_bad_vowel_sequence))
289 291 else if splitDiphth then
290 292 if isDiphth v1 v2
291 293 then return [v1, v2, ','] ~~ vokfed (v3:xs)
292 294 else return [v1, ','] ~~ vokfed (v2:v3:xs)
293   - else throwError "Invalid triphthong detected"
  295 + else throwError $ Selsrera ["fadgau", str, vs] SRE_bad_vowel_sequence
294 296 slakate [] = return []
295 297 slakate str = return cs ~~ vokfed vs ~~ slakate rest
296 298 where (cs, r) = break isVy str
297 299 (vs, rest) = span isVy r
298 300 str' <- lerfad str >>= return . dropWhile (\c -> isSpace c || c == ',')
299 301 if take 1 str' == "'"
300   - then throwError "Apostrophes may not occur at the beginning of a string."
  302 + then throwError $ Selsrera ["fadgau", str] SRE_misplaced_apostrophe
301 303 else porfad str' >>= slakate
302 304
303 305 jvokatna, jvokatna' :: String -> Jvacux [String]
304 306 jvokatna str = fadgau str >>= jvokatna'
  307 + jvokatna' [] = throwError $ Selsrera ["jvokatna"] SRE_empty_string
305 308 jvokatna' str = do
306   - xusra (not $ hasNDJ str) "Invalid consonant triple in {lujvo}"
307   - xusra (noBadCC str) "Invalid consonant pair in {lujvo}"
  309 + let sregau vel lei = throwError $ Selsrera ("jvokatna" : str : vel) lei
  310 + when (elem ' ' str) (sregau [] SRE_no_spaces_allowed)
  311 + when (elem ',' str) (sregau [] SRE_no_commas_allowed)
  312 + noBadCC "jvokatna" str
  313 + hasNDJ "jvokatna" str
308 314 (pre, fanmo) <- case lertype (reverse str) of
309 315 V v2 : Apos : V v1 : C c1 : xs -> return (xs, [[c1, v1, '\'', v2]])
310 316 V v2 : V v1 : C c1 : xs | notElem v1 "iuIU" -> return (xs, [[c1, v1, v2]])
@@ -317,12 +323,12 @@ module Jbobaf.Vlatai (
317 323 = ccv' xs' ([c1', c2', v1'] : ccvs)
318 324 ccv' (V _:C _: _) _ = case xs of
319 325 V v' : C c' : xs' -> return (xs', [[c', v', c1, c2, v1]])
320   - _ -> throwError "jvokatna': Internal error #1: Don't panic"
  326 + _ -> sregau ["Internal error #1"] SRE_internal_error
321 327 ccv' xs' ccvs = return (xs', ccvs)
322   - _ -> throwError "Invalid final {rafsi}"
323   - xusra (not (null pre) || length fanmo >= 2)
324   - "{lujvo} must contain at least two {rafsi}."
325   - let katna [] rafs = return rafs
  328 + xs -> sregau [reverse $ unlertype xs, ""] SRE_invalid_rafsi
  329 + when (null pre && length fanmo < 2) (sregau [] SRE_not_enough_rafsi)
  330 + let unraf = concatMap (\r -> r == [] ?: "y" :? r)
  331 + katna [] rafs = return rafs
326 332 katna (V v : C c2 : C c1 : xs) rafs | isCC [c1, c2]
327 333 = katna xs ([c1, c2, v] : rafs)
328 334 katna (V v2 : V v1 : C c : xs@(_:_)) rafs | notElem v1 "iuIU"
@@ -331,52 +337,58 @@ module Jbobaf.Vlatai (
331 337 = katna xs ([c, v1, '\'', v2] : rafs)
332 338 katna (C c2 : V v : C c1 : xs) rafs = katna xs ([c1, v, c2] : rafs)
333 339 katna (Y : C c3 : C c2 : V v : C c1 : xs) rafs | isC_C [c2, c3]
334   - = katna xs ([c1, v, c2, c3] : rafs)
335   - katna (Y : C c2 : V v : C c1 : xs) rafs =
  340 + = katna xs ([c1, v, c2, c3] : "y" : rafs)
  341 + katna ys@(Y : C c2 : V v : C c1 : xs) rafs@((cA:cB:_):_) =
336 342 let ccvc' (C c2' : V _ : C c1' : xs') p = isCC [c2', p] && ccvc' xs' c1'
337 343 ccvc' (C c:_) prec = isCC [c, prec]
338 344 ccvc' _ _ = False
339 345 in case (ccvc' xs c1, xs) of
340   - (True, C c0 : xs') -> katna xs' ([c0, c1, v, c2] : rafs)
341   - _ -> if isC_C [c2, head (head rafs)] && not (hasNDJ $ c2 : head rafs)
  346 + (True, C c0 : xs') -> katna xs' $ [c0, c1, v, c2] : "y" : rafs
  347 + _ -> if isC_C [c2,cA] && notElem [c2,cA,cB] ["ndj", "ndz", "ntc", "nts"]
342 348 then if isCC [c2, head (head rafs)]
343   - then katna xs ([c1, v, c2] : [] : rafs)
344   - else throwError "Superfluous Y-hyphen in {lujvo}"
345   - else katna xs ([c1, v, c2] : "y" : rafs)
  349 + then katna xs $ [c1, v, c2]:[]:rafs
  350 + else sregau [reverse $ unlertype ys, unraf rafs]
  351 + SRE_extra_Y_hyphen
  352 + else katna xs $ [c1, v, c2] : "y" : rafs
346 353 katna [rn, V v2, V v1, C c] rafs =
347 354 if rn == C (head (head rafs) == 'r' ?: 'n' :? 'r')
348 355 && (length rafs > 1 || raftai (head rafs) /= CCV) && notElem v1 "iuIU"
349 356 then return $ [c, v1, v2] : rafs
350   - else throwError "Invalid r/n-hyphen in {lujvo}"
  357 + else sregau [] SRE_bad_rn_hyphen
351 358 katna [rn, V v2, Apos, V v1, C c] rafs =
352 359 if rn == C (head (head rafs) == 'r' ?: 'n' :? 'r')
353 360 && (length rafs > 1 || raftai (head rafs) /= CCV)
354 361 then return $ [c, v1, '\'', v2] : rafs
355   - else throwError "Invalid r/n-hyphen in {lujvo}"
  362 + else sregau [] SRE_bad_rn_hyphen
356 363 katna [V v2, V v1, C c] rafs =
357 364 if length rafs == 1 && raftai (head rafs) == CCV && notElem v1 "iuIU"
358 365 then return $ [c, v1, v2] : rafs
359   - else throwError "R/n-hyphen missing from {lujvo}"
  366 + else sregau [] SRE_missing_rn_hyphen
360 367 katna [V v2, Apos, V v1, C c] rafs =
361 368 if length rafs == 1 && raftai (head rafs) == CCV
362 369 then return $ [c, v1, '\'', v2] : rafs
363   - else throwError "R/n-hyphen missing from {lujvo}"
364   - katna _ _ = throwError "Invalid {rafsi} form"
  370 + else sregau [] SRE_missing_rn_hyphen
  371 + katna mal rafs = sregau [reverse $ unlertype mal, unraf rafs]
  372 + SRE_invalid_rafsi
365 373 rolrafsi <- katna pre fanmo
366 374 let mulrafsi = filter (\r -> not (null r) && r /= "y") rolrafsi
367   - xusra (length (filter null rolrafsi) <= 1) "Superfluous Y-hyphen in {lujvo}"
368   - xusra (length mulrafsi >= 2) "{lujvo} must contain at least two {rafsi}."
  375 + tosCheck [] = return ()
  376 + tosCheck (x:_) = sregau [unraf pre, unraf post] SRE_extra_Y_hyphen
  377 + where (pre, post) = splitAt (x+1) rolrafsi
  378 + tosCheck $ tail $ findIndices null rolrafsi
  379 + when (length mulrafsi < 2) (sregau [] SRE_not_enough_rafsi)
  380 + -- Can ^this^ even happen at this point?
369 381 case span (\r -> raftai r == CVC || null r) rolrafsi of
370 382 (cvcs@(_:tsb:_), "y":_) ->
371 383 if has_C_C (concat cvcs) -- has_C_C ⇒ no need for a tosmabru hyphen
372   - then xusra (null $ filter null rolrafsi) "Superfluous Y-hyphen in {lujvo}"
373   - else xusra (null tsb) "{lujvo} missing tosmabru hyphen"
  384 + then tosCheck $ findIndices null rolrafsi
  385 + else unless (null tsb) (sregau [] SRE_tosmabru_failure)
374 386 (cvcs, [[_,_,c1,c2,_]]) | isCC [c1, c2] ->
375 387 if has_C_C (concat rolrafsi) -- has_C_C ⇒ no need for a tosmabru hyphen
376   - then xusra (null $ filter null rolrafsi) "Superfluous Y-hyphen in {lujvo}"
377   - else xusra (length cvcs > 1 && null (cvcs !! 1))
378   - "{lujvo} missing tosmabru hyphen"
379   - _ -> xusra (null $ filter null rolrafsi) "Superfluous Y-hyphen in {lujvo}"
  388 + then tosCheck $ findIndices null rolrafsi
  389 + else unless (length cvcs > 1 && null (cvcs !! 1))
  390 + (sregau [] SRE_tosmabru_failure)
  391 + _ -> tosCheck $ findIndices null rolrafsi
380 392 return mulrafsi
381 393
382 394 data Raftai = CVV | CCV | CVC | CCVC | CVC_C | CCVCV | CVC_CV | Srerafsi
@@ -400,21 +412,27 @@ module Jbobaf.Vlatai (
400 412
401 413 -- Unexported functions: ------------------------------------------------------
402 414
403   - hasNDJ :: String -> Bool
404   - hasNDJ str = case dropWhile (/= 'n') str of
405   - 'n':'d':'j':_ -> True
406   - 'n':'d':'z':_ -> True
407   - 'n':'t':'c':_ -> True
408   - 'n':'t':'s':_ -> True
409   - 'n':xs -> hasNDJ xs
410   - [] -> False
  415 + hasNDJ :: String -> String -> Jvacux ()
  416 + hasNDJ f str = ndj str
  417 + where ndj s = case dropWhile (/= 'n') s of
  418 + 'n':'d':'j':_ -> throwError $ Selsrera [f, str, "ndj"]
  419 + SRE_bad_consonant_triple
  420 + 'n':'d':'z':_ -> throwError $ Selsrera [f, str, "ndz"]
  421 + SRE_bad_consonant_triple
  422 + 'n':'t':'c':_ -> throwError $ Selsrera [f, str, "ndz"]
  423 + SRE_bad_consonant_triple
  424 + 'n':'t':'s':_ -> throwError $ Selsrera [f, str, "ndz"]
  425 + SRE_bad_consonant_triple
  426 + 'n':xs -> ndj xs
  427 + [] -> return ()
411 428
412   - noBadCC :: String -> Bool
413   - noBadCC str = null $ filter (\i -> let cc = take 2 (drop i str)
414   - in length cc /= 1 && (isC $ cc !! 1) && not (isC_C cc)) (findIndices isC str)
  429 + noBadCC :: String -> String -> Jvacux ()
  430 + noBadCC f str = case [cc | i <- findIndices isC str,
  431 + let cc = take 2 (drop i str), length cc /= 1, isC (cc !! 1), not (isC_C cc)]
  432 + of cc:_ -> throwError $ Selsrera [f, str, cc] SRE_bad_consonant_pair
  433 + [] -> return ()
415 434
416   - data Lertype = C Char | V Char | Y | Apos | BadCh
417   - deriving (Eq, Ord, Read, Show)
  435 + data Lertype = C Char | V Char | Y | Apos | BadCh Char deriving (Eq, Ord, Show)
418 436
419 437 lertype :: String -> [Lertype]
420 438 -- Pre-classifying letterals as consonants & vowels cuts down on obsessive
@@ -426,8 +444,12 @@ module Jbobaf.Vlatai (
426 444 lertype (c:xs)
427 445 | isC c = C c : lertype xs
428 446 | isV c = V c : lertype xs
429   - | otherwise = BadCh : lertype xs
  447 + | otherwise = BadCh c : lertype xs
430 448
431   - xusra :: Bool -> String -> Jvacux ()
432   - xusra True _ = return ()
433   - xusra False s = throwError s
  449 + unlertype :: [Lertype] -> String
  450 + unlertype (C c : xs) = c : unlertype xs
  451 + unlertype (V v : xs) = v : unlertype xs
  452 + unlertype (Y : xs) = 'y' : unlertype xs
  453 + unlertype (Apos : xs) = '\'' : unlertype xs
  454 + unlertype (BadCh c : xs) = c : unlertype xs
  455 + unlertype [] = []

0 comments on commit 0655915

Please sign in to comment.
Something went wrong with that request. Please try again.