如何正确地将文件列表转换为Haskell中的递归记录？

Question

我有以下文件名及其内容列表：

list :: [(TreeFilePath, String)]
list = [
    ("dir1/content1","1"),
    ("dir1/content11","11"),
    ("dir1/dir1/content1","1++"),
    ("dir1/dir1/content11","11++"),
    ("dir2/content2","2"),
    ("dir2/content21","21"),
    ("dir2/dir2/content2","2++"),
    ("dir2/dir2/content21","21++")
]

我想把它转换成下面的递归结构：

data Content = Content {
  content :: Either (Map TreeFilePath Content) String
} deriving (Eq, Show)

以下是我尝试这样做的方法：

pathsToContent :: [(TreeFilePath, String)] -> IO Content
pathsToContent [] = return $ Content $ Right ""
pathsToContent a@((fullPath, content):xs) = 
  let generatedContent = generateContentFromPathList pathList content
   in do
      processedContent <- pathsToContent xs 
      insertIntoContent processedContent generatedContent 

insertIntoContent :: Content -> Content -> IO Content
insertIntoContent a@(Content existingContent) b@(Content contentToAdd) = 
  do
    case existingContent of
      Right s -> do
        if (L.null s) then case contentToAdd of 
          Right _ -> return a 
          Left _ -> return b
        else return a
      Left m -> case contentToAdd of
        Right sa -> do
          if L.null sa then return a else insertIntoContent (Content $ Left $ insert (BS.pack sa) b m) b
        Left ma -> do
          if Data.Map.null ma then return a else 
            let filtered = Data.Map.foldrWithKey(\k a v -> case Data.Map.lookup k ma of Nothing -> v; Just f -> case content f of Right fs -> v; Left fm -> union fm v) Data.Map.empty m 
                key = Data.Map.foldrWithKey(\k a v -> case Data.Map.lookup k ma of Nothing -> v; Just f -> k) "" m 
                without = Data.Map.foldrWithKey(\k a v -> case Data.Map.lookup k m of 
                    Nothing -> case content a of 
                      Right fs -> v
                      Left fm -> union ma v
                    Just f -> v
                  ) Data.Map.empty ma 
             in do
              insertIntoContent (Content $ Left $ 
                if BS.null key 
                   then union m without 
                   else adjust (\a -> 
                     case content a of 
                       Right s -> Content $ Right s; 
                       Left am -> Content $ Left $ union am filtered
                     ) key m
                  ) (if BS.null key then Content $ Left without else Content $ Right "")

此代码的问题在于它没有对父目录进行嵌套检测以将子内容合并到。如果我运行下面的命令：

pathsToContent list

我得到以下结果：

Content {content = Left (fromList [
    ("dir1",Content {content = Left (fromList [
          ("content1",Content {content = Right "1"}),
          ("content11",Content {content = Right "11"}),
          ("dir1",Content {content = Left (fromList [
                ("content11",Content {content = Right "11++"})
          ])})
    ])}),
    ("dir2",Content {content = Left (fromList [
          ("content2",Content {content = Right "2"}),
          ("content21",Content {content = Right "21"}),
          ("dir2",Content {content = Left (fromList [
                ("content21",Content {content = Right "21++"})
          ])})
    ])})
])}

如您所见，结果中省略了文件 dir1/dir1/content1 和 dir2/dir2/content2。我无法弄清楚如何正确管理将这种情况的处理添加到转换算法中。如果您有任何想法如何让它发挥作用，我将不胜感激。谢谢！

Answer 1

我找到了解决方案：

pathsToContent :: [(TreeFilePath, String)] -> Content
pathsToContent [] = Content $ Right ""
pathsToContent ((fullPath, c):[]) = generateContentFromPathList (BS.split '/' fullPath) c 
pathsToContent a = 
    Content $ Left $ union (getFiles a) $ pathsToContents a

pathsToContents :: [(TreeFilePath, String)] -> Map TreeFilePath Content
pathsToContents [] = Data.Map.empty 
pathsToContents a@((fullPath, c):xs) = 
  let pathList = BS.split '/' fullPath
      pathHead = L.head pathList
      pathTail = L.tail pathList
      pathLast = L.last pathList
      files = getFiles $ pathsWithoutTheDirectory a ""
      xsc = pathsToContents xs
   in do
      if pathHead == pathLast 
         then mergeWithKey mergeMaps id id files xsc 
         else mergeWithKey mergeMaps id id xsc $ (fromList [(pathHead, pathsToContent $ pathsWithoutTheDirectory a pathHead)])

mergeMaps :: TreeFilePath -> Content -> Content -> Maybe Content 
mergeMaps k a b = (Just $ mergeContents a b) 

mergeContents :: Content -> Content -> Content
mergeContents a@(Content x1) b@(Content x2) = case x1 of
  Right x1s -> case x2 of 
    Right x2s -> Content $ Right $ x2s 
    Left x2m -> b 
  Left x1m -> case x2 of 
    Right x2s -> a 
    Left x2m -> Content $ Left $ mergeWithKey mergeMaps id id x1m x2m 

getFiles :: [(TreeFilePath, String)] -> Map TreeFilePath Content
getFiles [] = Data.Map.empty
getFiles ((fullPath, content):xs) = 
  let pathList = BS.split '/' fullPath
      pathLast = L.last pathList
      pathHead = L.head pathList
   in if pathLast == pathHead 
         then insert pathHead (Content $ Right content) (getFiles xs) 
         else getFiles xs
  
pathsWithoutTheDirectory :: [(TreeFilePath, String)] -> TreeFilePath -> [(TreeFilePath, String)]
pathsWithoutTheDirectory [] _ = []
pathsWithoutTheDirectory ((fullPath, content):xs) directory = 
  let pathList = BS.split '/' fullPath
      pathWithoutLast = L.init pathList
      pathLast = L.last pathList
      directoryList = BS.split '/' directory 
      directoryWithoutLast = L.init directoryList
  in
    case L.stripPrefix directoryList pathList of 
      Just pathWithoutDirectory -> (BS.intercalate "/" pathWithoutDirectory, content):(pathsWithoutTheDirectory xs directory) 
      Nothing -> pathsWithoutTheDirectory xs directory

generateContentFromPathList :: [TreeFilePath] -> String -> Content
generateContentFromPathList [] content = Content $ Right content
generateContentFromPathList (x:xs) content = Content $ Left $ fromList [(x, generateContentFromPathList xs content)]

如何正确地将文件列表转换为Haskell中的递归记录？

How to properly convert the list of files into a recursive record in Haskell?

haskell