{-# Language LambdaCase #-}
{-|
Description:
  Cursor-based navigation and modification of 'DirTree's.

This module should be imported qualified due to the very short names it exports.
-}
module System.Directory.Contents.Zipper where

import Control.Applicative
import Data.Map (Map)
import qualified Data.Map as Map
import System.FilePath

import System.Directory.Contents.Types

-- * Zipper

-- | A zipper for a 'DirTree'. As you navigate the tree, this keeps track of where
-- you are (which node is "focused" under your cursor) and how to reach parent, child,
-- and sibling nodes.
data DirZipper a = DirZipper
  { DirZipper a -> DirTree a
_dirZipper_cursor :: DirTree a -- ^ Cursor position
  , DirZipper a -> Map FilePath (DirTree a)
_dirZipper_siblings :: Map FilePath (DirTree a) -- ^ Siblings
  , DirZipper a -> [(DirTree a, Map FilePath (DirTree a))]
_dirZipper_elders :: [(DirTree a, Map FilePath (DirTree a))]
  -- ^ Parents and aunts/uncles, in reverse order (i.e., immediate ancestors first)
  }
  deriving (Int -> DirZipper a -> ShowS
[DirZipper a] -> ShowS
DirZipper a -> FilePath
(Int -> DirZipper a -> ShowS)
-> (DirZipper a -> FilePath)
-> ([DirZipper a] -> ShowS)
-> Show (DirZipper a)
forall a. Show a => Int -> DirZipper a -> ShowS
forall a. Show a => [DirZipper a] -> ShowS
forall a. Show a => DirZipper a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DirZipper a] -> ShowS
$cshowList :: forall a. Show a => [DirZipper a] -> ShowS
show :: DirZipper a -> FilePath
$cshow :: forall a. Show a => DirZipper a -> FilePath
showsPrec :: Int -> DirZipper a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DirZipper a -> ShowS
Show, ReadPrec [DirZipper a]
ReadPrec (DirZipper a)
Int -> ReadS (DirZipper a)
ReadS [DirZipper a]
(Int -> ReadS (DirZipper a))
-> ReadS [DirZipper a]
-> ReadPrec (DirZipper a)
-> ReadPrec [DirZipper a]
-> Read (DirZipper a)
forall a. Read a => ReadPrec [DirZipper a]
forall a. Read a => ReadPrec (DirZipper a)
forall a. Read a => Int -> ReadS (DirZipper a)
forall a. Read a => ReadS [DirZipper a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DirZipper a]
$creadListPrec :: forall a. Read a => ReadPrec [DirZipper a]
readPrec :: ReadPrec (DirZipper a)
$creadPrec :: forall a. Read a => ReadPrec (DirZipper a)
readList :: ReadS [DirZipper a]
$creadList :: forall a. Read a => ReadS [DirZipper a]
readsPrec :: Int -> ReadS (DirZipper a)
$creadsPrec :: forall a. Read a => Int -> ReadS (DirZipper a)
Read, DirZipper a -> DirZipper a -> Bool
(DirZipper a -> DirZipper a -> Bool)
-> (DirZipper a -> DirZipper a -> Bool) -> Eq (DirZipper a)
forall a. Eq a => DirZipper a -> DirZipper a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirZipper a -> DirZipper a -> Bool
$c/= :: forall a. Eq a => DirZipper a -> DirZipper a -> Bool
== :: DirZipper a -> DirZipper a -> Bool
$c== :: forall a. Eq a => DirZipper a -> DirZipper a -> Bool
Eq, Eq (DirZipper a)
Eq (DirZipper a)
-> (DirZipper a -> DirZipper a -> Ordering)
-> (DirZipper a -> DirZipper a -> Bool)
-> (DirZipper a -> DirZipper a -> Bool)
-> (DirZipper a -> DirZipper a -> Bool)
-> (DirZipper a -> DirZipper a -> Bool)
-> (DirZipper a -> DirZipper a -> DirZipper a)
-> (DirZipper a -> DirZipper a -> DirZipper a)
-> Ord (DirZipper a)
DirZipper a -> DirZipper a -> Bool
DirZipper a -> DirZipper a -> Ordering
DirZipper a -> DirZipper a -> DirZipper a
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
forall a. Ord a => Eq (DirZipper a)
forall a. Ord a => DirZipper a -> DirZipper a -> Bool
forall a. Ord a => DirZipper a -> DirZipper a -> Ordering
forall a. Ord a => DirZipper a -> DirZipper a -> DirZipper a
min :: DirZipper a -> DirZipper a -> DirZipper a
$cmin :: forall a. Ord a => DirZipper a -> DirZipper a -> DirZipper a
max :: DirZipper a -> DirZipper a -> DirZipper a
$cmax :: forall a. Ord a => DirZipper a -> DirZipper a -> DirZipper a
>= :: DirZipper a -> DirZipper a -> Bool
$c>= :: forall a. Ord a => DirZipper a -> DirZipper a -> Bool
> :: DirZipper a -> DirZipper a -> Bool
$c> :: forall a. Ord a => DirZipper a -> DirZipper a -> Bool
<= :: DirZipper a -> DirZipper a -> Bool
$c<= :: forall a. Ord a => DirZipper a -> DirZipper a -> Bool
< :: DirZipper a -> DirZipper a -> Bool
$c< :: forall a. Ord a => DirZipper a -> DirZipper a -> Bool
compare :: DirZipper a -> DirZipper a -> Ordering
$ccompare :: forall a. Ord a => DirZipper a -> DirZipper a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (DirZipper a)
Ord)

-- | Construct a zipper out of a 'DirTree'. Use 'focused' or 'unzipped' to get back
-- a 'DirTree'
zipped :: DirTree a -> DirZipper a
zipped :: DirTree a -> DirZipper a
zipped DirTree a
a = DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper DirTree a
a Map FilePath (DirTree a)
forall k a. Map k a
Map.empty []

-- | The currently focused/selected node (and its children).  In other words,
-- where you are in the directory hierarchy.
focused :: DirZipper a -> DirTree a
focused :: DirZipper a -> DirTree a
focused = DirZipper a -> DirTree a
forall a. DirZipper a -> DirTree a
_dirZipper_cursor

-- | Throws away your current cursor information and returns the entire 'DirTree'
-- contained by the 'DirZipper'.
--
-- > unzipped . zipped == id
--
unzipped :: DirZipper a -> DirTree a
unzipped :: DirZipper a -> DirTree a
unzipped = DirZipper a -> DirTree a
forall a. DirZipper a -> DirTree a
focused (DirZipper a -> DirTree a)
-> (DirZipper a -> DirZipper a) -> DirZipper a -> DirTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirZipper a -> DirZipper a
forall a. DirZipper a -> DirZipper a
home

-- | Move down a level in the directory hierarchy. To move down to a specific child,
-- use 'downTo'.
down :: DirZipper a -> Maybe (DirZipper a)
down :: DirZipper a -> Maybe (DirZipper a)
down DirZipper a
dz = case DirZipper a
dz of
  DirZipper p :: DirTree a
p@(DirTree_Dir FilePath
_ Map FilePath (DirTree a)
xs) Map FilePath (DirTree a)
siblings [(DirTree a, Map FilePath (DirTree a))]
parents ->
    Map FilePath (DirTree a)
-> (DirTree a -> Map FilePath (DirTree a) -> DirZipper a)
-> Maybe (DirZipper a)
forall a x.
Map FilePath (DirTree a)
-> (DirTree a -> Map FilePath (DirTree a) -> x) -> Maybe x
withFirstChild Map FilePath (DirTree a)
xs ((DirTree a -> Map FilePath (DirTree a) -> DirZipper a)
 -> Maybe (DirZipper a))
-> (DirTree a -> Map FilePath (DirTree a) -> DirZipper a)
-> Maybe (DirZipper a)
forall a b. (a -> b) -> a -> b
$ \DirTree a
firstChild Map FilePath (DirTree a)
children ->
      DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper DirTree a
firstChild Map FilePath (DirTree a)
children ([(DirTree a, Map FilePath (DirTree a))] -> DirZipper a)
-> [(DirTree a, Map FilePath (DirTree a))] -> DirZipper a
forall a b. (a -> b) -> a -> b
$ (DirTree a
p, Map FilePath (DirTree a)
siblings) (DirTree a, Map FilePath (DirTree a))
-> [(DirTree a, Map FilePath (DirTree a))]
-> [(DirTree a, Map FilePath (DirTree a))]
forall a. a -> [a] -> [a]
: [(DirTree a, Map FilePath (DirTree a))]
parents
  DirZipper p :: DirTree a
p@(DirTree_Symlink FilePath
_ (Symlink_External FilePath
_ Map FilePath (DirTree a)
xs)) Map FilePath (DirTree a)
siblings [(DirTree a, Map FilePath (DirTree a))]
parents ->
    Map FilePath (DirTree a)
-> (DirTree a -> Map FilePath (DirTree a) -> DirZipper a)
-> Maybe (DirZipper a)
forall a x.
Map FilePath (DirTree a)
-> (DirTree a -> Map FilePath (DirTree a) -> x) -> Maybe x
withFirstChild Map FilePath (DirTree a)
xs ((DirTree a -> Map FilePath (DirTree a) -> DirZipper a)
 -> Maybe (DirZipper a))
-> (DirTree a -> Map FilePath (DirTree a) -> DirZipper a)
-> Maybe (DirZipper a)
forall a b. (a -> b) -> a -> b
$ \DirTree a
firstChild Map FilePath (DirTree a)
children ->
      DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper DirTree a
firstChild Map FilePath (DirTree a)
children ([(DirTree a, Map FilePath (DirTree a))] -> DirZipper a)
-> [(DirTree a, Map FilePath (DirTree a))] -> DirZipper a
forall a b. (a -> b) -> a -> b
$ (DirTree a
p, Map FilePath (DirTree a)
siblings) (DirTree a, Map FilePath (DirTree a))
-> [(DirTree a, Map FilePath (DirTree a))]
-> [(DirTree a, Map FilePath (DirTree a))]
forall a. a -> [a] -> [a]
: [(DirTree a, Map FilePath (DirTree a))]
parents
  DirZipper (DirTree_Symlink FilePath
_ (Symlink_Internal FilePath
_ FilePath
ref)) Map FilePath (DirTree a)
_ [(DirTree a, Map FilePath (DirTree a))]
_ ->
    FilePath -> DirZipper a -> Maybe (DirZipper a)
forall a. FilePath -> DirZipper a -> Maybe (DirZipper a)
followRelative FilePath
ref (DirZipper a -> Maybe (DirZipper a))
-> DirZipper a -> Maybe (DirZipper a)
forall a b. (a -> b) -> a -> b
$ DirZipper a -> DirZipper a
forall a. DirZipper a -> DirZipper a
home DirZipper a
dz
  DirZipper a
_ -> Maybe (DirZipper a)
forall a. Maybe a
Nothing

-- | Move up a level in the directory hierarchy, back to the parent that you
-- previously moved 'down' through.
up :: DirZipper a -> Maybe (DirZipper a)
up :: DirZipper a -> Maybe (DirZipper a)
up = \case
  DirZipper DirTree a
c Map FilePath (DirTree a)
s ((DirTree a
parent, Map FilePath (DirTree a)
uncles):[(DirTree a, Map FilePath (DirTree a))]
ps) ->
    DirZipper a -> Maybe (DirZipper a)
forall a. a -> Maybe a
Just (DirZipper a -> Maybe (DirZipper a))
-> DirZipper a -> Maybe (DirZipper a)
forall a b. (a -> b) -> a -> b
$ DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper (DirTree a -> Map FilePath (DirTree a) -> DirTree a -> DirTree a
forall a.
DirTree a -> Map FilePath (DirTree a) -> DirTree a -> DirTree a
update DirTree a
c Map FilePath (DirTree a)
s DirTree a
parent) Map FilePath (DirTree a)
uncles [(DirTree a, Map FilePath (DirTree a))]
ps
  DirZipper a
_ -> Maybe (DirZipper a)
forall a. Maybe a
Nothing
  where
    update :: DirTree a -> Map FilePath (DirTree a) -> DirTree a -> DirTree a
    update :: DirTree a -> Map FilePath (DirTree a) -> DirTree a -> DirTree a
update DirTree a
child Map FilePath (DirTree a)
siblings DirTree a
parent = case DirTree a
parent of
      DirTree_Dir FilePath
f Map FilePath (DirTree a)
_ -> FilePath -> Map FilePath (DirTree a) -> DirTree a
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
f (Map FilePath (DirTree a) -> DirTree a)
-> Map FilePath (DirTree a) -> DirTree a
forall a b. (a -> b) -> a -> b
$ DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
insertSibling DirTree a
child Map FilePath (DirTree a)
siblings
      DirTree_Symlink FilePath
f (Symlink_External FilePath
s Map FilePath (DirTree a)
_) ->
        FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
f (Symlink a -> DirTree a) -> Symlink a -> DirTree a
forall a b. (a -> b) -> a -> b
$ FilePath -> Map FilePath (DirTree a) -> Symlink a
forall a. FilePath -> Map FilePath (DirTree a) -> Symlink a
Symlink_External FilePath
s (Map FilePath (DirTree a) -> Symlink a)
-> Map FilePath (DirTree a) -> Symlink a
forall a b. (a -> b) -> a -> b
$ DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
insertSibling DirTree a
child Map FilePath (DirTree a)
siblings
      DirTree a
_ -> DirTree a
parent

-- | Go to the top of the directory hierarchy.
home :: DirZipper a -> DirZipper a
home :: DirZipper a -> DirZipper a
home DirZipper a
dz =
  let upmost :: DirZipper a -> DirZipper a
upmost DirZipper a
z = DirZipper a
-> (DirZipper a -> DirZipper a)
-> Maybe (DirZipper a)
-> DirZipper a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DirZipper a
z DirZipper a -> DirZipper a
upmost (Maybe (DirZipper a) -> DirZipper a)
-> Maybe (DirZipper a) -> DirZipper a
forall a b. (a -> b) -> a -> b
$ DirZipper a -> Maybe (DirZipper a)
forall a. DirZipper a -> Maybe (DirZipper a)
up DirZipper a
z
  in DirZipper a -> DirZipper a
forall a. DirZipper a -> DirZipper a
upmost DirZipper a
dz

-- | Navigation directions for sibling nodes
data NavSibling = NavLeft | NavRight

-- | Move to the sibling next to the focused node
nextSibling :: NavSibling -> DirZipper a -> Maybe (DirZipper a)
nextSibling :: NavSibling -> DirZipper a -> Maybe (DirZipper a)
nextSibling NavSibling
nav (DirZipper DirTree a
cursor Map FilePath (DirTree a)
siblings [(DirTree a, Map FilePath (DirTree a))]
parents) =
  let kids :: Map FilePath (DirTree a)
kids = DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
insertSibling DirTree a
cursor Map FilePath (DirTree a)
siblings
      next :: Maybe (FilePath, DirTree a)
next = case NavSibling
nav of
        NavSibling
NavRight -> FilePath -> Map FilePath (DirTree a) -> Maybe (FilePath, DirTree a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (DirTree a -> FilePath
forall a. DirTree a -> FilePath
fileName DirTree a
cursor) Map FilePath (DirTree a)
kids
        NavSibling
NavLeft -> FilePath -> Map FilePath (DirTree a) -> Maybe (FilePath, DirTree a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLT (DirTree a -> FilePath
forall a. DirTree a -> FilePath
fileName DirTree a
cursor) Map FilePath (DirTree a)
kids
  in case Maybe (FilePath, DirTree a)
next of
      Maybe (FilePath, DirTree a)
Nothing -> Maybe (DirZipper a)
forall a. Maybe a
Nothing
      Just (FilePath
_, DirTree a
sibling) -> DirZipper a -> Maybe (DirZipper a)
forall a. a -> Maybe a
Just (DirZipper a -> Maybe (DirZipper a))
-> DirZipper a -> Maybe (DirZipper a)
forall a b. (a -> b) -> a -> b
$
        DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper DirTree a
sibling (DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
removeSibling DirTree a
sibling Map FilePath (DirTree a)
kids) [(DirTree a, Map FilePath (DirTree a))]
parents

-- | Move to the sibling to the left of the focused node
left :: DirZipper a -> Maybe (DirZipper a)
left :: DirZipper a -> Maybe (DirZipper a)
left = NavSibling -> DirZipper a -> Maybe (DirZipper a)
forall a. NavSibling -> DirZipper a -> Maybe (DirZipper a)
nextSibling NavSibling
NavLeft

-- | Move to the sibling to the right of the focused node
right :: DirZipper a -> Maybe (DirZipper a)
right :: DirZipper a -> Maybe (DirZipper a)
right = NavSibling -> DirZipper a -> Maybe (DirZipper a)
forall a. NavSibling -> DirZipper a -> Maybe (DirZipper a)
nextSibling NavSibling
NavRight

-- | Go to a particular sibling
toSibling :: FileName -> DirZipper a -> Maybe (DirZipper a)
toSibling :: FilePath -> DirZipper a -> Maybe (DirZipper a)
toSibling FilePath
name (DirZipper DirTree a
cursor Map FilePath (DirTree a)
siblings [(DirTree a, Map FilePath (DirTree a))]
parents) =
  case FilePath -> Map FilePath (DirTree a) -> Maybe (DirTree a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
name Map FilePath (DirTree a)
siblings of
    Maybe (DirTree a)
Nothing -> Maybe (DirZipper a)
forall a. Maybe a
Nothing
    Just DirTree a
sibling ->
      let otherSiblings :: Map FilePath (DirTree a)
otherSiblings = DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
insertSibling DirTree a
cursor (Map FilePath (DirTree a) -> Map FilePath (DirTree a))
-> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a b. (a -> b) -> a -> b
$
            DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
removeSibling DirTree a
sibling Map FilePath (DirTree a)
siblings
      in DirZipper a -> Maybe (DirZipper a)
forall a. a -> Maybe a
Just (DirZipper a -> Maybe (DirZipper a))
-> DirZipper a -> Maybe (DirZipper a)
forall a b. (a -> b) -> a -> b
$ DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper DirTree a
sibling Map FilePath (DirTree a)
otherSiblings [(DirTree a, Map FilePath (DirTree a))]
parents

-- | Move down in the directory hierarchy to a particular child
downTo :: FileName -> DirZipper a -> Maybe (DirZipper a)
downTo :: FilePath -> DirZipper a -> Maybe (DirZipper a)
downTo FilePath
name DirZipper a
z = do
  DirZipper a
d <- DirZipper a -> Maybe (DirZipper a)
forall a. DirZipper a -> Maybe (DirZipper a)
down DirZipper a
z
  if DirTree a -> FilePath
forall a. DirTree a -> FilePath
fileName (DirZipper a -> DirTree a
forall a. DirZipper a -> DirTree a
focused DirZipper a
d) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
name
    then DirZipper a -> Maybe (DirZipper a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DirZipper a
d
    else FilePath -> DirZipper a -> Maybe (DirZipper a)
forall a. FilePath -> DirZipper a -> Maybe (DirZipper a)
toSibling FilePath
name DirZipper a
d

-- | Modify the focused node
mapCursor
  :: (DirTree a -> DirTree a)
  -> DirZipper a
  -> DirZipper a
mapCursor :: (DirTree a -> DirTree a) -> DirZipper a -> DirZipper a
mapCursor DirTree a -> DirTree a
f (DirZipper DirTree a
cursor Map FilePath (DirTree a)
siblings [(DirTree a, Map FilePath (DirTree a))]
parents) =
  DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper (DirTree a -> DirTree a
f DirTree a
cursor) Map FilePath (DirTree a)
siblings [(DirTree a, Map FilePath (DirTree a))]
parents

-- | Replace the focused node
replaceCursor
  :: DirTree a
  -> DirZipper a
  -> DirZipper a
replaceCursor :: DirTree a -> DirZipper a -> DirZipper a
replaceCursor = (DirTree a -> DirTree a) -> DirZipper a -> DirZipper a
forall a. (DirTree a -> DirTree a) -> DirZipper a -> DirZipper a
mapCursor ((DirTree a -> DirTree a) -> DirZipper a -> DirZipper a)
-> (DirTree a -> DirTree a -> DirTree a)
-> DirTree a
-> DirZipper a
-> DirZipper a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirTree a -> DirTree a -> DirTree a
forall a b. a -> b -> a
const

-- | Add a new sibling to the focused node's generation and focus on it
insert
  :: DirTree a
  -> DirZipper a
  -> DirZipper a
insert :: DirTree a -> DirZipper a -> DirZipper a
insert DirTree a
d (DirZipper DirTree a
cursor Map FilePath (DirTree a)
siblings [(DirTree a, Map FilePath (DirTree a))]
parents) =
  DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper
    DirTree a
d
    (DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
insertSibling DirTree a
cursor Map FilePath (DirTree a)
siblings)
    [(DirTree a, Map FilePath (DirTree a))]
parents

-- | Remove the focused node
remove
  :: DirZipper a
  -> Maybe (DirZipper a)
remove :: DirZipper a -> Maybe (DirZipper a)
remove z :: DirZipper a
z@(DirZipper DirTree a
cursor Map FilePath (DirTree a)
_ [(DirTree a, Map FilePath (DirTree a))]
_) =
  let rm :: DirZipper a -> DirZipper a
rm (DirZipper DirTree a
c Map FilePath (DirTree a)
s [(DirTree a, Map FilePath (DirTree a))]
p) =
        DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
forall a.
DirTree a
-> Map FilePath (DirTree a)
-> [(DirTree a, Map FilePath (DirTree a))]
-> DirZipper a
DirZipper DirTree a
c (DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
forall a.
DirTree a -> Map FilePath (DirTree a) -> Map FilePath (DirTree a)
removeSibling DirTree a
cursor Map FilePath (DirTree a)
s) [(DirTree a, Map FilePath (DirTree a))]
p
  in case DirZipper a -> DirZipper a
rm (DirZipper a -> DirZipper a)
-> Maybe (DirZipper a) -> Maybe (DirZipper a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DirZipper a -> Maybe (DirZipper a)
forall a. DirZipper a -> Maybe (DirZipper a)
left DirZipper a
z Maybe (DirZipper a) -> Maybe (DirZipper a) -> Maybe (DirZipper a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DirZipper a -> Maybe (DirZipper a)
forall a. DirZipper a -> Maybe (DirZipper a)
right DirZipper a
z) of
    Just DirZipper a
s -> DirZipper a -> Maybe (DirZipper a)
forall a. a -> Maybe a
Just DirZipper a
s
    Maybe (DirZipper a)
Nothing -> case DirZipper a -> Maybe (DirZipper a)
forall a. DirZipper a -> Maybe (DirZipper a)
up DirZipper a
z of
      Maybe (DirZipper a)
Nothing -> Maybe (DirZipper a)
forall a. Maybe a
Nothing
      Just DirZipper a
dz -> DirZipper a -> Maybe (DirZipper a)
forall a. a -> Maybe a
Just (DirZipper a -> Maybe (DirZipper a))
-> DirZipper a -> Maybe (DirZipper a)
forall a b. (a -> b) -> a -> b
$ (DirTree a -> DirZipper a -> DirZipper a)
-> DirZipper a -> DirTree a -> DirZipper a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DirTree a -> DirZipper a -> DirZipper a
forall a. DirTree a -> DirZipper a -> DirZipper a
replaceCursor DirZipper a
dz (DirTree a -> DirZipper a) -> DirTree a -> DirZipper a
forall a b. (a -> b) -> a -> b
$
        case DirZipper a -> DirTree a
forall a. DirZipper a -> DirTree a
_dirZipper_cursor DirZipper a
dz of
          DirTree_Dir FilePath
f Map FilePath (DirTree a)
_ -> FilePath -> Map FilePath (DirTree a) -> DirTree a
forall a. FilePath -> Map FilePath (DirTree a) -> DirTree a
DirTree_Dir FilePath
f Map FilePath (DirTree a)
forall k a. Map k a
Map.empty
          DirTree_Symlink FilePath
f (Symlink_External FilePath
s Map FilePath (DirTree a)
_) ->
            FilePath -> Symlink a -> DirTree a
forall a. FilePath -> Symlink a -> DirTree a
DirTree_Symlink FilePath
f (FilePath -> Map FilePath (DirTree a) -> Symlink a
forall a. FilePath -> Map FilePath (DirTree a) -> Symlink a
Symlink_External FilePath
s Map FilePath (DirTree a)
forall k a. Map k a
Map.empty)
          DirTree a
x -> DirTree a
x

-- | Try to navigate the provided (possibly relative) path.
followRelative
  :: FilePath
  -> DirZipper a
  -> Maybe (DirZipper a)
followRelative :: FilePath -> DirZipper a -> Maybe (DirZipper a)
followRelative FilePath
path DirZipper a
dz =
  let follow :: FilePath -> DirZipper a -> Maybe (DirZipper a)
follow FilePath
r DirZipper a
z = case FilePath
r of
        FilePath
"." -> DirZipper a -> Maybe (DirZipper a)
forall a. a -> Maybe a
Just DirZipper a
z
        FilePath
".." -> DirZipper a -> Maybe (DirZipper a)
forall a. DirZipper a -> Maybe (DirZipper a)
up DirZipper a
z
        FilePath
_ -> FilePath -> DirZipper a -> Maybe (DirZipper a)
forall a. FilePath -> DirZipper a -> Maybe (DirZipper a)
downTo FilePath
r DirZipper a
z Maybe (DirZipper a) -> Maybe (DirZipper a) -> Maybe (DirZipper a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> DirZipper a -> Maybe (DirZipper a)
forall a. FilePath -> DirZipper a -> Maybe (DirZipper a)
toSibling FilePath
r DirZipper a
z
      go :: [FilePath] -> DirZipper a -> Maybe (DirZipper a)
go [FilePath]
rs DirZipper a
z = case [FilePath]
rs of
        [] -> DirZipper a -> Maybe (DirZipper a)
forall a. a -> Maybe a
Just DirZipper a
z
        (FilePath
r:[FilePath]
more) -> [FilePath] -> DirZipper a -> Maybe (DirZipper a)
go [FilePath]
more (DirZipper a -> Maybe (DirZipper a))
-> Maybe (DirZipper a) -> Maybe (DirZipper a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> DirZipper a -> Maybe (DirZipper a)
forall a. FilePath -> DirZipper a -> Maybe (DirZipper a)
follow FilePath
r DirZipper a
z
  in [FilePath] -> DirZipper a -> Maybe (DirZipper a)
forall a. [FilePath] -> DirZipper a -> Maybe (DirZipper a)
go (FilePath -> [FilePath]
splitDirectories FilePath
path) DirZipper a
dz

-- | If the focused node is an internal symlink (see 'Symlink'), try to get
-- to the target.
followLink
  :: DirZipper a
  -> Maybe (DirZipper a)
followLink :: DirZipper a -> Maybe (DirZipper a)
followLink DirZipper a
z = case DirZipper a
z of
  DirZipper (DirTree_Symlink FilePath
_ (Symlink_Internal FilePath
s FilePath
_)) Map FilePath (DirTree a)
_ [(DirTree a, Map FilePath (DirTree a))]
_ -> FilePath -> DirZipper a -> Maybe (DirZipper a)
forall a. FilePath -> DirZipper a -> Maybe (DirZipper a)
followRelative FilePath
s DirZipper a
z
  DirZipper a
_ -> Maybe (DirZipper a)
forall a. Maybe a
Nothing