{-# LANGUAGE ViewPatterns #-}

{- |
Copyright: (c) 2017-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Data type for representing filesystem structure via tree.
-}

module Summoner.Tree
       ( TreeFs (..)
       , traverseTree
       , pathToTree
       , insertTree
       , showBoldTree
       , showTree
       ) where

import Colourista (bold, reset)
import System.Directory (createDirectoryIfMissing, withCurrentDirectory)
import System.FilePath (splitDirectories)


-- | Describes simple structure of filesystem tree.
data TreeFs
      -- | Name of directory (relative) and its containing entries
    = Dir FilePath [TreeFs]
      -- | File name (relative) and file content
    | 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)

-- | Walks through directory tree and write file contents, creating all
-- intermediate directories.
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

{- | This function converts a string file path to the tree structure.

For a path like this: @".github/workflow/ci.yml"@

This function produces the following tree:

@
.github/
└── workflow/
    └── ci.yml
@
-}
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 []  -- shouldn't happen
        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]

{- | This functions inserts given 'TreeFs' node into the list of existing
'TreeFs' nodes. The behavior of this function is the following:

1. It merges duplicating directories.
2. It overrides existing 'File' with the given 'TreeFs' in case of duplicates.
-}
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

-- | Pretty shows the directory tree content.
showBoldTree :: TreeFs -> Text
showBoldTree :: TreeFs -> Text
showBoldTree = Bool -> TreeFs -> Text
showTree Bool
True

-- | Pretty shows tree with options.
showTree
    :: Bool    -- ^ Print directories bold.
    -> TreeFs  -- ^ Given tree.
    -> Text    -- ^ Pretty output.
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)

-- | Extract 'TreeFs' path. Used for sorting in alphabetic order.
treeFp :: TreeFs -> FilePath
treeFp :: TreeFs -> String
treeFp (Dir fp :: String
fp _)  = String
fp
treeFp (File fp :: String
fp _) = String
fp