fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

fix(WellKnownFiles): Removed debugtraces, enhanced error message.

Browse Source
This commit is contained in:
Stephan Barth 2024-05-30 12:30:45 +02:00
parent 3fd7ce7a71
commit ef2b2248dc
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Settings/WellKnownFiles/TH.hs
View File

@ -79,14 +79,14 @@ mkWellKnown defLang wellKnownBase wellKnownLinks = do
File{..} <- pure pFile File{..} <- pure pFile
guard $ name /= wellKnownLinks guard $ name /= wellKnownLinks
return $ file & _1 %~ makeRelative (wellKnownBase </> language) return $ file & _1 %~ makeRelative (wellKnownBase </> language)
return (Trace.trace ("### Trace language: (" ++ show language ++ ")") (Text.pack language, lContents')) return (Text.pack language, lContents')
| otherwise | otherwise
-> fail $ "wellKnownBase (" ++ wellKnownBase ++ ") is not a directory" -> fail $ "wellKnownBase (" ++ wellKnownBase ++ ") is not a directory"
fLanguages <- if fLanguages <- if
| defLang `Set.member` Map.keysSet languageFiles | defLang `Set.member` Map.keysSet languageFiles
, let languages' = Set.delete defLang $ Map.keysSet languageFiles , let languages' = Set.delete defLang $ Map.keysSet languageFiles
-> return $ Trace.trace ("### fLanguages: (" ++ show languages' ++ ")") (defLang :| Set.toList languages') -> return $ (defLang :| Set.toList languages')
| otherwise | otherwise
-> fail "default language is missing in wellKnownBase" -> fail "default language is missing in wellKnownBase"
@ -94,17 +94,20 @@ mkWellKnown defLang wellKnownBase wellKnownLinks = do
languageLinks <- if languageLinks <- if
| Dir{contents} <- inputFiles | Dir{contents} <- inputFiles
-- -> Trace.trace ("### Trace languageLinks (outer): (" ++ show contents ++ ")") $ return . Map.fromList $ do -- -> Trace.trace ("### Trace languageLinks (outer): (" ++ show contents ++ ")") $ return . Map.fromList $ do
-> Trace.trace ("### Trace languageLinks (outer): (" ++ "...show contents..." ++ ")") $ return . Map.fromList $ do -- -> Trace.trace ("### Trace languageLinks (outer): (" ++ "...show contents... (show contents seems to be ok and is too long to be useful?)" ++ ")") $ return . Map.fromList $ do
-> return . Map.fromList $ do
(language, lContents) <- contents ^.. folded . $(multifocusL 2) _name id (language, lContents) <- contents ^.. folded . $(multifocusL 2) _name id
Dir{} <- Trace.trace ("### Trace languageLinks (inner1): (" ++ show language ++ ")") $ pure lContents Dir{} <- pure lContents
let let
lContents' :: [ByteString] lContents' :: [ByteString]
lContents' = Trace.traceShowId $ flip mapMaybe (flattenDir lContents) $ \pFile -> do lContents' = Trace.traceShowId $ flip mapMaybe (flattenDir lContents) $ \pFile -> do
-- Trace.trace ("### Trace lContents' " ++ show pFile)
--File{..} <- Trace.trace ("### Trace one lContents' element " ++ show pFile) $ pure pFile
File{..} <- pure pFile File{..} <- pure pFile
guard $ name == wellKnownLinks guard $ name == wellKnownLinks
return $ file ^. _2 return $ file ^. _2
c <- lContents' c <- lContents'
return (Trace.trace ("### Trace languageLinks (inner): (" ++ show language ++ ")") (Text.pack language, c)) return (Text.pack language, c)
| otherwise | otherwise
-> fail "wellKnownBase is not a directory" -> fail "wellKnownBase is not a directory"
@ -112,6 +115,8 @@ mkWellKnown defLang wellKnownBase wellKnownLinks = do
| defLang `Set.member` Map.keysSet languageLinks | defLang `Set.member` Map.keysSet languageLinks
, let languages' = Set.delete defLang $ Map.keysSet languageLinks , let languages' = Set.delete defLang $ Map.keysSet languageLinks
-> return $ defLang :| Set.toList languages' -> return $ defLang :| Set.toList languages'
| null languageLinks
-> fail $ "no languageLinks in wellKnownBase; " ++ wellKnownLinks ++ " might be missing"
| otherwise | otherwise
-> fail ("default language is missing in wellKnownBase" ++ "; default language is '" ++ (show defLang) ++ "' ; list of known languages is " ++ (show $ Map.keys languageLinks)) -> fail ("default language is missing in wellKnownBase" ++ "; default language is '" ++ (show defLang) ++ "' ; list of known languages is " ++ (show $ Map.keys languageLinks))