{-# LANGUAGE ViewPatterns #-}
module Summoner.Tree
( TreeFs (..)
, traverseTree
, pathToTree
, insertTree
, showBoldTree
, showTree
) where
import Colourista (bold, reset)
import System.Directory (createDirectoryIfMissing, withCurrentDirectory)
import System.FilePath (splitDirectories)
data TreeFs
= Dir FilePath [TreeFs]
| File FilePath Text
deriving stock ((forall x. TreeFs -> Rep TreeFs x)
-> (forall x. Rep TreeFs x -> TreeFs) -> Generic TreeFs
forall x. Rep TreeFs x -> TreeFs
forall x. TreeFs -> Rep TreeFs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TreeFs x -> TreeFs
$cfrom :: forall x. TreeFs -> Rep TreeFs x
Generic, Int -> TreeFs -> ShowS
[TreeFs] -> ShowS
TreeFs -> String
(Int -> TreeFs -> ShowS)
-> (TreeFs -> String) -> ([TreeFs] -> ShowS) -> Show TreeFs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeFs] -> ShowS
$cshowList :: [TreeFs] -> ShowS
show :: TreeFs -> String
$cshow :: TreeFs -> String
showsPrec :: Int -> TreeFs -> ShowS
$cshowsPrec :: Int -> TreeFs -> ShowS
Show, TreeFs -> TreeFs -> Bool
(TreeFs -> TreeFs -> Bool)
-> (TreeFs -> TreeFs -> Bool) -> Eq TreeFs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeFs -> TreeFs -> Bool
$c/= :: TreeFs -> TreeFs -> Bool
== :: TreeFs -> TreeFs -> Bool
$c== :: TreeFs -> TreeFs -> Bool
Eq, Eq TreeFs
Eq TreeFs =>
(TreeFs -> TreeFs -> Ordering)
-> (TreeFs -> TreeFs -> Bool)
-> (TreeFs -> TreeFs -> Bool)
-> (TreeFs -> TreeFs -> Bool)
-> (TreeFs -> TreeFs -> Bool)
-> (TreeFs -> TreeFs -> TreeFs)
-> (TreeFs -> TreeFs -> TreeFs)
-> Ord TreeFs
TreeFs -> TreeFs -> Bool
TreeFs -> TreeFs -> Ordering
TreeFs -> TreeFs -> TreeFs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TreeFs -> TreeFs -> TreeFs
$cmin :: TreeFs -> TreeFs -> TreeFs
max :: TreeFs -> TreeFs -> TreeFs
$cmax :: TreeFs -> TreeFs -> TreeFs
>= :: TreeFs -> TreeFs -> Bool
$c>= :: TreeFs -> TreeFs -> Bool
> :: TreeFs -> TreeFs -> Bool
$c> :: TreeFs -> TreeFs -> Bool
<= :: TreeFs -> TreeFs -> Bool
$c<= :: TreeFs -> TreeFs -> Bool
< :: TreeFs -> TreeFs -> Bool
$c< :: TreeFs -> TreeFs -> Bool
compare :: TreeFs -> TreeFs -> Ordering
$ccompare :: TreeFs -> TreeFs -> Ordering
$cp1Ord :: Eq TreeFs
Ord)
traverseTree :: TreeFs -> IO ()
traverseTree :: TreeFs -> IO ()
traverseTree (File name :: String
name content :: Text
content) = String -> Text -> IO ()
forall (m :: * -> *). MonadIO m => String -> Text -> m ()
writeFileText String
name Text
content
traverseTree (Dir name :: String
name children :: [TreeFs]
children) = do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
name
String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withCurrentDirectory String
name (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [TreeFs] -> (TreeFs -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TreeFs]
children TreeFs -> IO ()
traverseTree
pathToTree :: FilePath -> Text -> TreeFs
pathToTree :: String -> Text -> TreeFs
pathToTree path :: String
path content :: Text
content =
let pathParts :: [String]
pathParts = String -> [String]
splitDirectories String
path
in case [String]
pathParts of
[] -> String -> [TreeFs] -> TreeFs
Dir String
path []
x :: String
x:xs :: [String]
xs -> String -> [String] -> TreeFs
go String
x [String]
xs
where
go :: FilePath -> [FilePath] -> TreeFs
go :: String -> [String] -> TreeFs
go p :: String
p [] = String -> Text -> TreeFs
File String
p Text
content
go p :: String
p (x :: String
x:xs :: [String]
xs) = String -> [TreeFs] -> TreeFs
Dir String
p [String -> [String] -> TreeFs
go String
x [String]
xs]
insertTree :: TreeFs -> [TreeFs] -> [TreeFs]
insertTree :: TreeFs -> [TreeFs] -> [TreeFs]
insertTree node :: TreeFs
node [] = [TreeFs
node]
insertTree node :: TreeFs
node (x :: TreeFs
x:xs :: [TreeFs]
xs) = case (TreeFs
node, TreeFs
x) of
(Dir _ _, File _ _) -> TreeFs
x TreeFs -> [TreeFs] -> [TreeFs]
forall a. a -> [a] -> [a]
: TreeFs -> [TreeFs] -> [TreeFs]
insertTree TreeFs
node [TreeFs]
xs
(File _ _, Dir _ _) -> TreeFs
x TreeFs -> [TreeFs] -> [TreeFs]
forall a. a -> [a] -> [a]
: TreeFs -> [TreeFs] -> [TreeFs]
insertTree TreeFs
node [TreeFs]
xs
(File nodePath :: String
nodePath _, File curPath :: String
curPath _)
| String
nodePath String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
curPath -> TreeFs
node TreeFs -> [TreeFs] -> [TreeFs]
forall a. a -> [a] -> [a]
: [TreeFs]
xs
| Bool
otherwise -> TreeFs
x TreeFs -> [TreeFs] -> [TreeFs]
forall a. a -> [a] -> [a]
: TreeFs -> [TreeFs] -> [TreeFs]
insertTree TreeFs
node [TreeFs]
xs
(Dir nodePath :: String
nodePath nodeChildren :: [TreeFs]
nodeChildren, Dir curPath :: String
curPath curChildren :: [TreeFs]
curChildren)
| String
nodePath String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
curPath ->
String -> [TreeFs] -> TreeFs
Dir String
nodePath ((TreeFs -> [TreeFs] -> [TreeFs])
-> [TreeFs] -> [TreeFs] -> [TreeFs]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TreeFs -> [TreeFs] -> [TreeFs]
insertTree [TreeFs]
curChildren [TreeFs]
nodeChildren) TreeFs -> [TreeFs] -> [TreeFs]
forall a. a -> [a] -> [a]
: [TreeFs]
xs
| Bool
otherwise -> TreeFs
x TreeFs -> [TreeFs] -> [TreeFs]
forall a. a -> [a] -> [a]
: TreeFs -> [TreeFs] -> [TreeFs]
insertTree TreeFs
node [TreeFs]
xs
showBoldTree :: TreeFs -> Text
showBoldTree :: TreeFs -> Text
showBoldTree = Bool -> TreeFs -> Text
showTree Bool
True
showTree
:: Bool
-> TreeFs
-> Text
showTree :: Bool -> TreeFs -> Text
showTree isBold :: Bool
isBold = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> (TreeFs -> [Text]) -> TreeFs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> TreeFs -> [Text]
showOne " " "" ""
where
showOne :: Text -> Text -> Text -> TreeFs -> [Text]
showOne :: Text -> Text -> Text -> TreeFs -> [Text]
showOne leader :: Text
leader tie :: Text
tie arm :: Text
arm (File fp :: String
fp _) = [Text
leader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tie Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
fp]
showOne leader :: Text
leader tie :: Text
tie arm :: Text
arm (Dir fp :: String
fp ((TreeFs -> String) -> [TreeFs] -> [TreeFs]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith TreeFs -> String
treeFp -> [TreeFs]
trees)) =
Text
nodeRep Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [TreeFs] -> Text -> [Text]
showChildren [TreeFs]
trees (Text
leader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
extension)
where
nodeRep :: Text
nodeRep :: Text
nodeRep = Text
leader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tie Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
boldDir (String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "/")
where
boldDir :: FilePath -> Text
boldDir :: String -> Text
boldDir str :: String
str = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
if Bool
isBold
then String
forall str. IsString str => str
bold String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
forall str. IsString str => str
reset
else String
str
extension :: Text
extension :: Text
extension = case Text
arm of "" -> ""; "└" -> " "; _ -> "│ "
showChildren :: [TreeFs] -> Text -> [Text]
showChildren :: [TreeFs] -> Text -> [Text]
showChildren children :: [TreeFs]
children leader :: Text
leader =
let arms :: [Text]
arms = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([TreeFs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TreeFs]
children Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) "├" [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ["└"]
in [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Text -> TreeFs -> [Text]) -> [Text] -> [TreeFs] -> [[Text]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text -> Text -> Text -> TreeFs -> [Text]
showOne Text
leader "── ") [Text]
arms [TreeFs]
children)
treeFp :: TreeFs -> FilePath
treeFp :: TreeFs -> String
treeFp (Dir fp :: String
fp _) = String
fp
treeFp (File fp :: String
fp _) = String
fp