{-# LANGUAGE ViewPatterns #-}
module Summoner.Tree
( TreeFs (..)
, traverseTree
, showTree
) where
import Universum
import System.Directory (createDirectoryIfMissing, withCurrentDirectory)
data TreeFs
= Dir FilePath [TreeFs]
| File FilePath Text
traverseTree :: TreeFs -> IO ()
traverseTree (Dir name children) = do
createDirectoryIfMissing False name
withCurrentDirectory name $ for_ children traverseTree
traverseTree (File name content) = writeFile name content
showTree :: TreeFs -> Text
showTree = unlines . showOne " " "" ""
showOne :: Text -> Text -> Text -> TreeFs -> [Text]
showOne leader tie arm (File fp _) = [leader <> arm <> tie <> toText fp]
showOne leader tie arm (Dir fp (sortWith treeFp -> trees)) =
nodeRep : showChildren trees (leader <> extension)
where
nodeRep :: Text
nodeRep = leader <> arm <> tie <> toText fp
extension :: Text
extension = case arm of "" -> ""; "└" -> " "; _ -> "│ "
showChildren :: [TreeFs] -> Text -> [Text]
showChildren children leader =
let arms = replicate (length children - 1) "│" <> ["└"]
in concat (zipWith (showOne leader "── ") arms children)
treeFp :: TreeFs -> FilePath
treeFp (Dir fp _) = fp
treeFp (File fp _) = fp