Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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
View
@@ -60,12 +60,11 @@ module Jbobaf.Canti where
where (c, r) = span isC str
(v, rest) = span isVy r
+ -- |Tests whether a syllable contains a non-Y vowel and is thus vocalic
voc :: String -> Bool
- -- Tests whether a syllable contains a non-Y vowel and is thus accentable.
- -- The short name is solely for aesthetic reasons.
- voc = not . null . filter isV
+ voc = any isV
+ -- |Checks for the presence of a non-initial valid consonant pair
has_C_C :: String -> Bool
- -- checks for the presence of a non-initial valid consonant pair
- has_C_C str = not $ null $ filter (\i -> let cc = take 2 $ drop i str
- in isC_C cc && not (isCC cc)) (findIndices isC str)
+ has_C_C str = any (\i -> let cc = take 2 $ drop i str
+ in isC_C cc && not (isCC cc)) $ findIndices isC str
102 haskell/Jbobaf/Jitro.hs
View
@@ -1,4 +1,5 @@
--- |Run-time configuration options and a Reader monad for keeping track of them
+-- |Run-time configuration options and a combined Reader-Error monad for
+-- keeping track of them
module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
where
@@ -7,9 +8,10 @@ module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
import Control.Monad.Error
import Control.Monad.Reader
- type Jvacux a = ReaderT (Set Tercuxna) (Either String) a
+ type JvacuxT m a = ReaderT (Set Tercuxna) m a
+ type Jvacux a = ReaderT (Set Tercuxna) (Either Selsrera) a
- isOpt, isNopt :: Monad m => Tercuxna -> ReaderT (Set Tercuxna) m Bool
+ isOpt, isNopt :: Monad m => Tercuxna -> JvacuxT m Bool
isOpt = asks . member
isNopt = asks . notMember
@@ -17,14 +19,18 @@ module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
xusnada m = (m >> return True) `mplus` return False
nupre :: Jvacux a -> Set Tercuxna -> a
- nupre jct opts = either error id $ runReaderT jct opts
+ nupre jct opts = either (error . show) id $ runReaderT jct opts
+ -- Flesh out this ^^^ later!!!
- -- Are these two functions necessary and/or useful?
+ -- Are the following three functions necessary and/or useful?
- fliba :: String -> Jvacux a
+ fliba :: Selsrera -> Jvacux a
fliba = throwError
- kavbu :: Jvacux a -> (String -> Jvacux a) -> Jvacux a
+ fliba' :: String -> Jvacux a
+ fliba' = throwError . strMsg
+
+ kavbu :: Jvacux a -> (Selsrera -> Jvacux a) -> Jvacux a
kavbu = catchError
data Tercuxna =
@@ -96,3 +102,85 @@ module Jbobaf.Jitro (module Jbobaf.Jitro, runReaderT, throwError, catchError)
defaults = fromList [Use_dotside, Allow_accents, Ignore_naljbo_chars,
Allow_triphthongs, Allow_H, Allow_ndj_in_fu'ivla, Allow_ndj_in_cmevla,
No_commas_in_cmavo, Translate_digits, Split_bad_diphthongs]
+
+ data Srelei =
+ SRE_internal_error -- something that is not supposed to happen
+ | SRE_invalid_word_form -- generic morphological failure
+ | SRE_empty_string
+ | SRE_invalid_emphasis
+ | SRE_bad_consonant_pair
+ | SRE_bad_consonant_triple
+ | SRE_tosmabru_failure
+ | SRE_slinku'i_failure
+ | SRE_bad_vowel_sequence -- bad diphthong, triphthong, etc.
+ | SRE_no_spaces_allowed -- internal spaces/periods not allowed
+ | SRE_lacks_cluster -- consonant cluster absent from {fu'ivla}
+ | SRE_non_Lojban_char -- non-Lojbanic character in string
+ | SRE_misplaced_apostrophe
+ | SRE_no_commas_allowed
+ | SRE_no_Ys_allowed -- applies only to {fu'ivla}?
+ | SRE_na'e_fu'ivla -- proposed {fu'ivla} is actually a {gismu} or {lujvo}
+ | SRE_bad_rn_hyphen -- includes superfluous r/n-hyphens
+ | SRE_missing_rn_hyphen
+ | SRE_too_much_before_cluster
+ -- two many letters or {ma'osmi} before a consonant cluster in a {brivla}
+ | SRE_extra_Y_hyphen
+ -- sre_valsi !! 2 == the normalized portion of the {lujvo} up through the Y
+ -- sre_valsi !! 3 == the normalized portion of the {lujvo} after the Y
+ | SRE_invalid_rafsi
+ -- sre_valsi !! 2 == the {lujvo} up through the end of the bad {rafsi}
+ -- sre_valsi !! 3 == the {lujvo} after the bad {rafsi}
+ | SRE_la_in_cmevla -- when the dotside is not in effect
+ | SRE_not_enough_rafsi
+ | SRE_not_enough_syllables -- vocalic syllables, that is
+ | SRE_must_end_with_vowel
+ | SRE_must_end_with_consonant
+ | SRE_breaks_apart -- into smaller words
+ | SRE_non_initial_start -- begins with non-initial consonant cluster
+ | SRE_consonant_inside_cmavo -- includes single consonants as {cmavo}
+ | SRE_other_error
+ deriving (Eq, Ord, Read, Show, Bounded, Enum, Ix)
+
+ data Selsrera = Selsrera {
+ sre_velski :: [String],
+ -- description of the error; first element is usually the name of the
+ -- function that threw it, second element (if present) is the erroneous
+ -- argument to the function, third element (if present) is the problematic
+ -- substring of the second element
+ sre_klesi :: Srelei
+ } deriving (Eq, Ord, Read, Show)
+
+ instance Error Selsrera where
+ noMsg = Selsrera ["noMsg"] SRE_other_error
+ strMsg s = Selsrera ["strMsg", s] SRE_other_error
+
+{-
+ Error messages:
+ - SRE_na'e_fu'ivla - "{fu'ivla} may not be {gismu} or {lujvo}."
+ - SRE_no_spaces_allowed - "{valsi} may not have internal spaces or periods."
+ - SRE_must_end_with_vowel - "{brivla} must end with a vowel."
+ - SRE_no_Ys_allowed - "{fu'ivla} may not contain Y's."
+ - SRE_not_enough_syllables - "{brivla} must contain two or more vocalic syllables."
+ - SRE_non_initial_start - "Non-initial consonant clusters may not occur at the start of a {fu'ivla}."
+ - SRE_too_much_before_cluster - "The consonant cluster in a {fu'ivla} may be preceded by no more than three letters."
+ - "A consonant cluster in a {fu'ivla} must be preceded by no more than one {ma'osmi}."
+ - SRE_breaks_apart - "{fu'ivla} may not break apart into smaller words."
+ - SRE_lacks_cluster - "{fu'ivla} must contain a consonant cluster."
+ - SRE_must_end_with_consonant - "{cmevla} must end with a consonant."
+ - SRE_la_in_cmevla - "{cmevla} may not contain the strings \"la\", \"lai\", \"la'i\", or \"doi\"."
+ - SRE_consonant_inside_cmavo - "{cmavo} may not have internal spaces, periods, or consonants."
+ - SRE_non_Lojban_char - "Non-Lojbanic character in string"
+ - SRE_misplaced_apostrophe - "Apostrophe next to a non-vowel detected."
+ - "Apostrophes may not occur at the end of a string."
+ - "Apostrophes may not occur at the beginning of a string."
+ - SRE_bad_vowel_sequence - "Invalid diphthong detected"
+ - "Invalid 4-vowel sequence detected"
+ - "Invalid triphthong detected"
+ - SRE_not_enough_rafsi - "{lujvo} must contain at least two {rafsi}."
+ - SRE_extra_Y_hyphen - "Superfluous Y-hyphen in {lujvo}"
+ - SRE_bad_rn_hyphen - "Invalid r/n-hyphen in {lujvo}"
+ - SRE_missing_rn_hyphen - "R/n-hyphen missing from {lujvo}"
+ - SRE_invalid_rafsi - "Invalid {rafsi} form"
+ - SRE_tosmabru_failure - "{lujvo} missing tosmabru hyphen"
+ - SRE_invalid_emphasis - "Invalid {brivla} emphasis"
+-}
238 haskell/Jbobaf/Vlatai.hs
View
@@ -19,7 +19,7 @@ module Jbobaf.Vlatai (
import Char
import Ix
import List (findIndices)
- import Monad (mplus)
+ import Monad (mplus, when, unless)
import qualified Data.Set as Set
import Jbobaf.Canti
import Jbobaf.Jitro
@@ -76,53 +76,53 @@ module Jbobaf.Vlatai (
brivla_xusra' str = gismu_xusra' str
`mplus` lujvo_xusra' str
`mplus` fu'ivla_xusra' str
- `mplus` throwError "This string is not a {brivla}."
-
+ `mplus` throwError (Selsrera ["brivla_xusra", str] SRE_invalid_word_form)
+
gismu_xusra, gismu_xusra' :: String -> Jvacux ()
gismu_xusra str = fadgau str >>= gismu_xusra'
- gismu_xusra' [a, b, c, d, e] = do
+ gismu_xusra' [] = throwError $ Selsrera ["gismu_xusra"] SRE_empty_string
+ gismu_xusra' s@[a, b, c, d, e] = do
noemph <- isOpt Ignore_brivla_emphasis
- xusra (isC a && isC d && isV e && (isV b && isC c && isC_C [c, d]
- || isC b && isV c && isCC [a, b])) "Invalid {gismu} form"
- xusra (noemph || not (isUpper e)) "Invalid {brivla} emphasis"
- gismu_xusra' _ = throwError "{gismu} must be five letterals long."
+ unless (isC a && isC d && isV e && (isV b && isC c && isC_C [c, d]
+ || isC b && isV c && isCC [a, b]))
+ (throwError $ Selsrera ["gismu_xusra", s] SRE_invalid_word_form)
+ when (not noemph && isUpper e) (throwError $ Selsrera ["gismu_xusra", s]
+ SRE_invalid_emphasis)
+ gismu_xusra' s = throwError $ Selsrera ["gismu_xusra", s] SRE_invalid_word_form
lujvo_xusra, lujvo_xusra' :: String -> Jvacux ()
lujvo_xusra str = fadgau str >>= lujvo_xusra'
lujvo_xusra' str = do
noemph <- isOpt Ignore_brivla_emphasis
let sylls = syllabicate str
- emphQty = length $ filter (not . null . filter isUpper) sylls
+ emphQty = length $ filter (any isUpper) sylls
jvokatna' str
- xusra (noemph || emphQty == 0 || emphQty == 1
- && not (null $ filter isUpper $ last $ init $ filter voc sylls))
- "Invalid {brivla} emphasis"
+ unless (noemph || emphQty == 0 || emphQty == 1 && any isUpper (last $ init
+ $ filter voc sylls)) (throwError $ Selsrera ["lujvo_xusra", str]
+ SRE_invalid_emphasis)
fu'ivla_xusra, fu'ivla_xusra' :: String -> Jvacux ()
fu'ivla_xusra str = fadgau str >>= fu'ivla_xusra'
+ fu'ivla_xusra' [] = throwError $ Selsrera ["fu'ivla_xusra"] SRE_empty_string
fu'ivla_xusra' str = do
noemph <- isOpt Ignore_brivla_emphasis
canY <- isOpt Allow_Y_in_fu'ivla
ndj <- isOpt Allow_ndj_in_fu'ivla
let vocSyls = filter voc $ syllabicate str
- emphQty = length $ filter (not . null . filter isUpper) vocSyls
- xusra (not $ null str) "{fu'ivla} must be non-empty."
- xugismu' str >>= flip xusra "{fu'ivla} may not be {gismu}." . not
- xulujvo' str >>= flip xusra "{fu'ivla} may not be {lujvo}." . not
- if isC (head str) then (xulujvo' $ 't':'o':str)
- >>= flip xusra "{fu'ivla} may not fail the tosmabru test" . not
- else return ()
- xusra (notElem ' ' str) "{fu'ivla} may not have internal spaces or periods."
- xusra (isV $ last str) "{fu'ivla} must end with a vowel."
- xusra (noBadCC str) "{fu'ivla} may not contain any invalid consonant pairs."
- xusra (ndj || not (hasNDJ str)) "{fu'ivla} may not contain the strings\
- \ \"ndj\", \"ndz\", \"ntc\", or \"nts\"."
- xusra (canY || notElem 'y' str) "{fu'ivla} may not contain Y's."
- xusra (length vocSyls >= 2)
- "{fu'ivla} must contain two or more vocalic syllables."
- xusra (noemph || emphQty == 0 || emphQty == 1
- && not (null $ filter isUpper $ last $ init vocSyls))
- "Invalid {brivla} emphasis"
+ emphQty = length $ filter (any isUpper) vocSyls
+ sregau = throwError . Selsrera ["fu'ivla_xusra", str]
+ xugismu' str >>= flip when (sregau SRE_na'e_fu'ivla)
+ xulujvo' str >>= flip when (sregau SRE_na'e_fu'ivla)
+ when (isC $ head str)
+ $ xulujvo' ('t':'o':str) >>= flip when (sregau SRE_slinku'i_failure)
+ when (elem ' ' str) (sregau SRE_no_spaces_allowed)
+ unless (isV $ last str) (sregau SRE_must_end_with_vowel)
+ noBadCC "fu'ivla_xusra" str
+ unless ndj $ hasNDJ "fu'ivla_xusra" str
+ unless (canY || notElem 'y' str) (sregau SRE_no_Ys_allowed)
+ when (length vocSyls < 2) (sregau SRE_not_enough_syllables)
+ unless (noemph || emphQty == 0 || emphQty == 1 && any isUpper (last
+ $ init vocSyls)) (sregau SRE_invalid_emphasis)
case findC_C str of
Just ccLoc -> do
let (clust, rest) = span (\c -> isC c || c == 'y') (drop ccLoc str)
@@ -133,41 +133,41 @@ module Jbobaf.Vlatai (
|| length (filter voc $ syllabicate rest) == 1
|| ccLoc /= 0 && slinky
then do
- xusra (ccLoc /= 0) "Non-initial consonant clusters may not occur at the\
- \ start of a {fu'ivla}."
- xusra (length (filter (`notElem` "',y") preclust) <= 3) "The consonant\
- \ cluster in a {fu'ivla} may be preceded by no more than three letters."
- xusra (preCs == 1 && isC (head preclust) || preCs == 0) "A consonant\
- \ cluster in a {fu'ivla} must be preceded by no more than one {ma'osmi}."
- else xusra (ccLoc == 0) "{fu'ivla} may not break apart into smaller words."
- Nothing -> throwError "{fu'ivla} must contain a consonant cluster."
+ when (ccLoc == 0) (sregau SRE_non_initial_start)
+ unless (length (filter (`notElem` "',y") preclust) <= 3)
+ (sregau SRE_too_much_before_cluster)
+ unless (preCs == 1 && isC (head preclust) || preCs == 0)
+ (sregau SRE_too_much_before_cluster)
+ else unless (ccLoc == 0) (sregau SRE_breaks_apart)
+ Nothing -> sregau SRE_lacks_cluster
cmevla_xusra, cmevla_xusra' :: String -> Jvacux ()
cmevla_xusra str = fadgau str >>= cmevla_xusra'
- cmevla_xusra' [] = throwError "{cmevla} must be non-empty."
+ cmevla_xusra' [] = throwError $ Selsrera ["cmevla_xusra"] SRE_empty_string
cmevla_xusra' str = do
dotty <- isOpt Use_dotside
ndj <- isOpt Allow_ndj_in_cmevla
- xusra (isC $ last str) "{cmevla} must end with a consonant."
- xusra (notElem ' ' str) "{cmevla} may not have internal spaces or periods."
- xusra (noBadCC str) "{cmevla} may not contain any invalid consonant pairs."
- case (dotty, findLa str, ndj, hasNDJ str) of
- (False, Just _, _, _) -> throwError "{cmevla} may not contain the strings\
- \ \"la\", \"lai\", \"la'i\", or \"doi\"."
- (_, _, False, True) -> throwError "{cmevla} may not contain the strings\
- \ \"ndj\", \"ndz\", \"ntc\", or \"nts\"."
- _ -> return ()
+ let sregau = throwError . Selsrera ["cmevla_xusra", str]
+ unless (isC $ last str) (sregau SRE_must_end_with_consonant)
+ when (elem ' ' str) (sregau SRE_no_spaces_allowed)
+ noBadCC "cmevla_xusra" str
+ unless ndj $ hasNDJ "cmevla_xusra" str
+ unless dotty (case findLa str of
+ Just (_, la, _) -> throwError $ Selsrera ["cmevla_xusra", str, la]
+ SRE_la_in_cmevla
+ Nothing -> return ())
cmavo_xusra, cmavo_xusra' :: String -> Jvacux ()
cmavo_xusra str = fadgau str >>= cmavo_xusra'
- cmavo_xusra' [] = throwError "{cmavo} must be non-empty."
+ cmavo_xusra' [] = throwError $ Selsrera ["cmavo_xusra"] SRE_empty_string
cmavo_xusra' str@(c:xs) = do
commas <- isNopt No_commas_in_cmavo
let maho = if isC c then xs else str
- xusra (not $ null maho) "A single consonant is not a {cmavo}."
- xusra (null $ filter (\c -> isSpace c || isC c) maho)
- "{cmavo} may not have internal spaces, periods, or consonants."
- xusra (commas || notElem ',' maho) "{cmavo} may not contain commas."
+ sregau = throwError . Selsrera ["cmavo_xusra", str]
+ when (elem ' ' str) (sregau SRE_no_spaces_allowed)
+ when (null maho) (sregau SRE_consonant_inside_cmavo)
+ when (any isC maho) (sregau SRE_consonant_inside_cmavo)
+ unless (commas || notElem ',' maho) (sregau SRE_no_commas_allowed)
-- |@fadgau@ is a basic \"cleanup\" routine used by various functions in
-- Jbobaf for converting Lojban text into a more regular, \"normalized\" form.
@@ -225,7 +225,7 @@ module Jbobaf.Vlatai (
lerfad (c:xs) | isSpace c = ' ' ~: lerfad xs
lerfad (c:xs) | not (goodchr c) =
if ignoring then lerfad xs
- else throwError "Non-Lojbanic character in string"
+ else throwError $ Selsrera ["fadgau", str, [c]] SRE_non_Lojban_char
lerfad ('.':xs) = ' ' ~: lerfad xs
lerfad ('á':xs) = 'A' ~: lerfad xs
lerfad ('Á':xs) = 'A' ~: lerfad xs
@@ -264,11 +264,11 @@ module Jbobaf.Vlatai (
porfad (c:',':xs) | not (isVy c) = porfad (c:xs)
porfad (',':c:xs) | not (isVy c) = porfad (c:xs)
porfad ('\'':'\'':xs) = porfad ('\'':xs)
- porfad (c:'\'':xs)
- | not (isVy c) = throwError "Apostrophe next to a non-vowel detected."
- porfad ('\'':c:xs)
- | not (isVy c) = throwError "Apostrophe next to a non-vowel detected."
- porfad "'"= throwError "Apostrophes may not occur at the end of a string."
+ porfad (c:'\'':xs) | not (isVy c) =
+ throwError $ Selsrera ["fadgau", str, [c, '\'']] SRE_misplaced_apostrophe
+ porfad ('\'':c:xs) | not (isVy c) =
+ throwError $ Selsrera ["fadgau", str, ['\'', c]] SRE_misplaced_apostrophe
+ porfad "'"= throwError $ Selsrera ["fadgau", str] SRE_misplaced_apostrophe
porfad "," = return []
porfad " " = return []
porfad (' ':' ':xs) = porfad (' ':xs)
@@ -281,30 +281,36 @@ module Jbobaf.Vlatai (
vokfed [v] = return [v]
vokfed [v1, v2] = if isDiphth v1 v2 then return [v1, v2]
else if splitDiphth then return [v1, ',', v2]
- else throwError "Invalid diphthong detected"
- vokfed (v1:v2:v3:xs) =
+ else throwError $ Selsrera ["fadgau", str, [v1, v2]]
+ SRE_bad_vowel_sequence
+ vokfed vs@(v1:v2:v3:xs) =
if triphth && v1 `elem` "iuIU" && isDiphth v2 v3
then return [v1, v2, v3] ~~ (null xs ?: return [] :? splitDiphth
- ?: ',' ~: vokfed xs :? throwError "Invalid 4-vowel sequence detected")
+ ?: ',' ~: vokfed xs
+ :? throwError (Selsrera ["fadgau", str, vs] SRE_bad_vowel_sequence))
else if splitDiphth then
if isDiphth v1 v2
then return [v1, v2, ','] ~~ vokfed (v3:xs)
else return [v1, ','] ~~ vokfed (v2:v3:xs)
- else throwError "Invalid triphthong detected"
+ else throwError $ Selsrera ["fadgau", str, vs] SRE_bad_vowel_sequence
slakate [] = return []
slakate str = return cs ~~ vokfed vs ~~ slakate rest
where (cs, r) = break isVy str
(vs, rest) = span isVy r
str' <- lerfad str >>= return . dropWhile (\c -> isSpace c || c == ',')
if take 1 str' == "'"
- then throwError "Apostrophes may not occur at the beginning of a string."
+ then throwError $ Selsrera ["fadgau", str] SRE_misplaced_apostrophe
else porfad str' >>= slakate
jvokatna, jvokatna' :: String -> Jvacux [String]
jvokatna str = fadgau str >>= jvokatna'
+ jvokatna' [] = throwError $ Selsrera ["jvokatna"] SRE_empty_string
jvokatna' str = do
- xusra (not $ hasNDJ str) "Invalid consonant triple in {lujvo}"
- xusra (noBadCC str) "Invalid consonant pair in {lujvo}"
+ let sregau vel lei = throwError $ Selsrera ("jvokatna" : str : vel) lei
+ when (elem ' ' str) (sregau [] SRE_no_spaces_allowed)
+ when (elem ',' str) (sregau [] SRE_no_commas_allowed)
+ noBadCC "jvokatna" str
+ hasNDJ "jvokatna" str
(pre, fanmo) <- case lertype (reverse str) of
V v2 : Apos : V v1 : C c1 : xs -> return (xs, [[c1, v1, '\'', v2]])
V v2 : V v1 : C c1 : xs | notElem v1 "iuIU" -> return (xs, [[c1, v1, v2]])
@@ -317,12 +323,12 @@ module Jbobaf.Vlatai (
= ccv' xs' ([c1', c2', v1'] : ccvs)
ccv' (V _:C _: _) _ = case xs of
V v' : C c' : xs' -> return (xs', [[c', v', c1, c2, v1]])
- _ -> throwError "jvokatna': Internal error #1: Don't panic"
+ _ -> sregau ["Internal error #1"] SRE_internal_error
ccv' xs' ccvs = return (xs', ccvs)
- _ -> throwError "Invalid final {rafsi}"
- xusra (not (null pre) || length fanmo >= 2)
- "{lujvo} must contain at least two {rafsi}."
- let katna [] rafs = return rafs
+ xs -> sregau [reverse $ unlertype xs, ""] SRE_invalid_rafsi
+ when (null pre && length fanmo < 2) (sregau [] SRE_not_enough_rafsi)
+ let unraf = concatMap (\r -> r == [] ?: "y" :? r)
+ katna [] rafs = return rafs
katna (V v : C c2 : C c1 : xs) rafs | isCC [c1, c2]
= katna xs ([c1, c2, v] : rafs)
katna (V v2 : V v1 : C c : xs@(_:_)) rafs | notElem v1 "iuIU"
@@ -331,52 +337,58 @@ module Jbobaf.Vlatai (
= katna xs ([c, v1, '\'', v2] : rafs)
katna (C c2 : V v : C c1 : xs) rafs = katna xs ([c1, v, c2] : rafs)
katna (Y : C c3 : C c2 : V v : C c1 : xs) rafs | isC_C [c2, c3]
- = katna xs ([c1, v, c2, c3] : rafs)
- katna (Y : C c2 : V v : C c1 : xs) rafs =
+ = katna xs ([c1, v, c2, c3] : "y" : rafs)
+ katna ys@(Y : C c2 : V v : C c1 : xs) rafs@((cA:cB:_):_) =
let ccvc' (C c2' : V _ : C c1' : xs') p = isCC [c2', p] && ccvc' xs' c1'
ccvc' (C c:_) prec = isCC [c, prec]
ccvc' _ _ = False
in case (ccvc' xs c1, xs) of
- (True, C c0 : xs') -> katna xs' ([c0, c1, v, c2] : rafs)
- _ -> if isC_C [c2, head (head rafs)] && not (hasNDJ $ c2 : head rafs)
+ (True, C c0 : xs') -> katna xs' $ [c0, c1, v, c2] : "y" : rafs
+ _ -> if isC_C [c2,cA] && notElem [c2,cA,cB] ["ndj", "ndz", "ntc", "nts"]
then if isCC [c2, head (head rafs)]
- then katna xs ([c1, v, c2] : [] : rafs)
- else throwError "Superfluous Y-hyphen in {lujvo}"
- else katna xs ([c1, v, c2] : "y" : rafs)
+ then katna xs $ [c1, v, c2]:[]:rafs
+ else sregau [reverse $ unlertype ys, unraf rafs]
+ SRE_extra_Y_hyphen
+ else katna xs $ [c1, v, c2] : "y" : rafs
katna [rn, V v2, V v1, C c] rafs =
if rn == C (head (head rafs) == 'r' ?: 'n' :? 'r')
&& (length rafs > 1 || raftai (head rafs) /= CCV) && notElem v1 "iuIU"
then return $ [c, v1, v2] : rafs
- else throwError "Invalid r/n-hyphen in {lujvo}"
+ else sregau [] SRE_bad_rn_hyphen
katna [rn, V v2, Apos, V v1, C c] rafs =
if rn == C (head (head rafs) == 'r' ?: 'n' :? 'r')
&& (length rafs > 1 || raftai (head rafs) /= CCV)
then return $ [c, v1, '\'', v2] : rafs
- else throwError "Invalid r/n-hyphen in {lujvo}"
+ else sregau [] SRE_bad_rn_hyphen
katna [V v2, V v1, C c] rafs =
if length rafs == 1 && raftai (head rafs) == CCV && notElem v1 "iuIU"
then return $ [c, v1, v2] : rafs
- else throwError "R/n-hyphen missing from {lujvo}"
+ else sregau [] SRE_missing_rn_hyphen
katna [V v2, Apos, V v1, C c] rafs =
if length rafs == 1 && raftai (head rafs) == CCV
then return $ [c, v1, '\'', v2] : rafs
- else throwError "R/n-hyphen missing from {lujvo}"
- katna _ _ = throwError "Invalid {rafsi} form"
+ else sregau [] SRE_missing_rn_hyphen
+ katna mal rafs = sregau [reverse $ unlertype mal, unraf rafs]
+ SRE_invalid_rafsi
rolrafsi <- katna pre fanmo
let mulrafsi = filter (\r -> not (null r) && r /= "y") rolrafsi
- xusra (length (filter null rolrafsi) <= 1) "Superfluous Y-hyphen in {lujvo}"
- xusra (length mulrafsi >= 2) "{lujvo} must contain at least two {rafsi}."
+ tosCheck [] = return ()
+ tosCheck (x:_) = sregau [unraf pre, unraf post] SRE_extra_Y_hyphen
+ where (pre, post) = splitAt (x+1) rolrafsi
+ tosCheck $ tail $ findIndices null rolrafsi
+ when (length mulrafsi < 2) (sregau [] SRE_not_enough_rafsi)
+ -- Can ^this^ even happen at this point?
case span (\r -> raftai r == CVC || null r) rolrafsi of
(cvcs@(_:tsb:_), "y":_) ->
if has_C_C (concat cvcs) -- has_C_C ⇒ no need for a tosmabru hyphen
- then xusra (null $ filter null rolrafsi) "Superfluous Y-hyphen in {lujvo}"
- else xusra (null tsb) "{lujvo} missing tosmabru hyphen"
+ then tosCheck $ findIndices null rolrafsi
+ else unless (null tsb) (sregau [] SRE_tosmabru_failure)
(cvcs, [[_,_,c1,c2,_]]) | isCC [c1, c2] ->
if has_C_C (concat rolrafsi) -- has_C_C ⇒ no need for a tosmabru hyphen
- then xusra (null $ filter null rolrafsi) "Superfluous Y-hyphen in {lujvo}"
- else xusra (length cvcs > 1 && null (cvcs !! 1))
- "{lujvo} missing tosmabru hyphen"
- _ -> xusra (null $ filter null rolrafsi) "Superfluous Y-hyphen in {lujvo}"
+ then tosCheck $ findIndices null rolrafsi
+ else unless (length cvcs > 1 && null (cvcs !! 1))
+ (sregau [] SRE_tosmabru_failure)
+ _ -> tosCheck $ findIndices null rolrafsi
return mulrafsi
data Raftai = CVV | CCV | CVC | CCVC | CVC_C | CCVCV | CVC_CV | Srerafsi
@@ -400,21 +412,27 @@ module Jbobaf.Vlatai (
-- Unexported functions: ------------------------------------------------------
- hasNDJ :: String -> Bool
- hasNDJ str = case dropWhile (/= 'n') str of
- 'n':'d':'j':_ -> True
- 'n':'d':'z':_ -> True
- 'n':'t':'c':_ -> True
- 'n':'t':'s':_ -> True
- 'n':xs -> hasNDJ xs
- [] -> False
+ hasNDJ :: String -> String -> Jvacux ()
+ hasNDJ f str = ndj str
+ where ndj s = case dropWhile (/= 'n') s of
+ 'n':'d':'j':_ -> throwError $ Selsrera [f, str, "ndj"]
+ SRE_bad_consonant_triple
+ 'n':'d':'z':_ -> throwError $ Selsrera [f, str, "ndz"]
+ SRE_bad_consonant_triple
+ 'n':'t':'c':_ -> throwError $ Selsrera [f, str, "ndz"]
+ SRE_bad_consonant_triple
+ 'n':'t':'s':_ -> throwError $ Selsrera [f, str, "ndz"]
+ SRE_bad_consonant_triple
+ 'n':xs -> ndj xs
+ [] -> return ()
- noBadCC :: String -> Bool
- noBadCC str = null $ filter (\i -> let cc = take 2 (drop i str)
- in length cc /= 1 && (isC $ cc !! 1) && not (isC_C cc)) (findIndices isC str)
+ noBadCC :: String -> String -> Jvacux ()
+ noBadCC f str = case [cc | i <- findIndices isC str,
+ let cc = take 2 (drop i str), length cc /= 1, isC (cc !! 1), not (isC_C cc)]
+ of cc:_ -> throwError $ Selsrera [f, str, cc] SRE_bad_consonant_pair
+ [] -> return ()
- data Lertype = C Char | V Char | Y | Apos | BadCh
- deriving (Eq, Ord, Read, Show)
+ data Lertype = C Char | V Char | Y | Apos | BadCh Char deriving (Eq, Ord, Show)
lertype :: String -> [Lertype]
-- Pre-classifying letterals as consonants & vowels cuts down on obsessive
@@ -426,8 +444,12 @@ module Jbobaf.Vlatai (
lertype (c:xs)
| isC c = C c : lertype xs
| isV c = V c : lertype xs
- | otherwise = BadCh : lertype xs
+ | otherwise = BadCh c : lertype xs
- xusra :: Bool -> String -> Jvacux ()
- xusra True _ = return ()
- xusra False s = throwError s
+ unlertype :: [Lertype] -> String
+ unlertype (C c : xs) = c : unlertype xs
+ unlertype (V v : xs) = v : unlertype xs
+ unlertype (Y : xs) = 'y' : unlertype xs
+ unlertype (Apos : xs) = '\'' : unlertype xs
+ unlertype (BadCh c : xs) = c : unlertype xs
+ unlertype [] = []
Please sign in to comment.
Something went wrong with that request. Please try again.