diff --git a/.gitignore b/.gitignore index cb59204..d67aa00 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,9 @@ dist +dist-newstyle cabal.sandbox.config + +# vim swapfiles +*.sw* + +# nix result symlinks +result* diff --git a/System/Directory/Tree.hs b/System/Directory/Tree.hs index 583d60c..2f5b3be 100644 --- a/System/Directory/Tree.hs +++ b/System/Directory/Tree.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} -------------------------------------------------------------------- -- | -- Module : System.Directory.Tree @@ -36,6 +37,7 @@ module System.Directory.Tree ( -- * Data types for representing directory trees DirTree (..) , AnchoredDirTree (..) + , IsName (..) , FileName @@ -82,8 +84,8 @@ module System.Directory.Tree ( -- * Lenses {- | These are compatible with the "lens" library -} - , _contents, _err, _file, _name - , _anchor, _dirTree + -- , _contents, _err, _file, _name + -- , _anchor, _dirTree ) where @@ -164,23 +166,37 @@ import System.IO.Unsafe(unsafeInterleaveIO) import Control.Applicative #endif --- | the String in the name field is always a file name, never a full path. --- The free type variable is used in the File constructor and can hold Handles, --- Strings representing a file's contents or anything else you can think of. --- We catch any IO errors in the Failed constructor. an Exception can be --- converted to a String with 'show'. -data DirTree a = Failed { name :: FileName, - err :: IOException } - | Dir { name :: FileName, - contents :: [DirTree a] } - | File { name :: FileName, - file :: a } - deriving Show +-- | A class of file names that can be converted to and from FilePaths (Strings). +-- Although not enforced, they should never contain path separators. +-- TODO is there anything built in that does this properly? Not IsString or Show. +class IsName n where + + -- TODO is this safe without checking for path separators? + p2n :: FilePath -> n + + n2p :: n -> FilePath + + -- Append a name to a FilePath + -- TODO call it pappend? something else? + nappend :: FilePath -> n -> FilePath + nappend p n = p n2p n + +-- | The first free type variable is for file names. The second is used in the +-- File constructor and can hold Handles, Strings representing a file's contents +-- or anything else you can think of. We catch any IO errors in the Failed +-- constructor. an Exception can be converted to a String with 'show'. +data DirTree n a = Failed { name :: n, + err :: IOException } + | Dir { name :: n, + contents :: [DirTree n a] } + | File { name :: n, + file :: a } + deriving Show -- | Two DirTrees are equal if they have the same constructor, the same name -- (and in the case of `Dir`s) their sorted `contents` are equal: -instance (Eq a)=> Eq (DirTree a) where +instance (Eq n, Ord n, Eq a)=> Eq (DirTree n a) where (File n a) == (File n' a') = n == n' && a == a' (Dir n cs) == (Dir n' cs') = n == n' && sortBy comparingConstr cs == sortBy comparingConstr cs' @@ -191,7 +207,7 @@ instance (Eq a)=> Eq (DirTree a) where -- | First compare constructors: Failed < Dir < File... -- Then compare `name`... -- Then compare free variable parameter of `File` constructors -instance (Ord a,Eq a) => Ord (DirTree a) where +instance (Ord n, Ord a, Eq n, Eq a) => Ord (DirTree n a) where compare (File n a) (File n' a') = case compare n n' of EQ -> compare a a' @@ -206,24 +222,29 @@ instance (Ord a,Eq a) => Ord (DirTree a) where -- | a simple wrapper to hold a base directory name, which can be either an --- absolute or relative path. This lets us give the DirTree a context, while +-- absolute or relative path. This lets us give the DirTree n a context, while -- still letting us store only directory and file /names/ (not full paths) in -- the DirTree. (uses an infix constructor; don't be scared) -data AnchoredDirTree a = (:/) { anchor :: FilePath, dirTree :: DirTree a } +data AnchoredDirTree n a = (:/) { anchor :: FilePath, dirTree :: DirTree n a } deriving (Show, Ord, Eq) --- | an element in a FilePath: +-- | an element in a FilePath. +-- TODO newtype wrapper here rather than using FlexibleInstances? +-- https://stackoverflow.com/a/8663534 type FileName = String +instance IsName FileName where + p2n = id + n2p = id -instance Functor DirTree where +instance Functor (DirTree n) where fmap = T.fmapDefault -instance F.Foldable DirTree where +instance F.Foldable (DirTree n) where foldMap = T.foldMapDefault -instance T.Traversable DirTree where +instance T.Traversable (DirTree n) where traverse f (Dir n cs) = Dir n <$> T.traverse (T.traverse f) cs traverse f (File n a) = File n <$> f a traverse _ (Failed n e) = pure (Failed n e) @@ -231,7 +252,7 @@ instance T.Traversable DirTree where -- for convenience: -instance Functor AnchoredDirTree where +instance Functor (AnchoredDirTree n) where fmap f (b:/d) = b :/ fmap f d @@ -249,7 +270,8 @@ infixl 4 -- Uses @readDirectoryWith readFile@ internally and has the effect of traversing the -- entire directory structure. See `readDirectoryWithL` for lazy production -- of a DirTree structure. -readDirectory :: FilePath -> IO (AnchoredDirTree String) +-- TODO version not specialized to FilePath? +readDirectory :: FilePath -> IO (AnchoredDirTree FilePath String) readDirectory = readDirectoryWith readFile @@ -263,7 +285,7 @@ readDirectory = readDirectoryWith readFile -- > readDirectoryWith return "../tmp" -- -- Note though that the 'build' function below already does this. -readDirectoryWith :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a) +readDirectoryWith :: IsName n => UserIO a -> FilePath -> IO (AnchoredDirTree n a) readDirectoryWith f p = buildWith' buildAtOnce' f p @@ -275,17 +297,17 @@ readDirectoryWith f p = buildWith' buildAtOnce' f p -- -- * side effects are tied to evaluation order and only run on demand -- * you might receive exceptions in pure code -readDirectoryWithL :: (FilePath -> IO a) -> FilePath -> IO (AnchoredDirTree a) +readDirectoryWithL :: IsName n => UserIO a -> FilePath -> IO (AnchoredDirTree n a) readDirectoryWithL f p = buildWith' buildLazilyUnsafe' f p -- | Generate a string that represents tree command-like output for a -- given DirTree. -- Instances of Failed will be removed from the tree before it is displayed. -- Use showTreeFormatted to apply formatting to the output. -showTree :: DirTree a -> String +showTree :: IsName n => DirTree n a -> String showTree tree = let treeNoFailed = filterDir notFailed tree - nameOnlyF = \x -> name x + nameOnlyF = \x -> n2p $ name x treeM = showTree' nameOnlyF "" True treeNoFailed in fromMaybe "" treeM where notFailed (Failed _ _) = False @@ -297,7 +319,7 @@ showTree tree = -- objects within the tree to be customized. -- If combined with a package such as ansi-terminal, this allows the tree -- output to be colourized. -showTreeFormatted :: (DirTree a -> String) -> DirTree a -> String +showTreeFormatted :: (DirTree n a -> String) -> DirTree n a -> String showTreeFormatted formatF tree = let treeNoFailed = filterDir notFailed tree treeM = showTree' formatF "" True treeNoFailed @@ -315,7 +337,7 @@ substituteJoiner joiner str = then take (length str - indWidth) str <> (joiner:"──") else str -showTree' :: (DirTree a -> String) -> String -> Bool -> DirTree a -> Maybe String +showTree' :: (DirTree n a -> String) -> String -> Bool -> DirTree n a -> Maybe String showTree' formatF prelimStr isLast dir@(Dir nm conts) = let joiner = if isLast then '└' else '├' thisLineStr = substituteJoiner joiner prelimStr @@ -337,7 +359,8 @@ showTree' _ _ _ (Failed _ _) = error "Cannot showTree' for Failed" -- Doesn't affect files in the directories (if any already exist) with -- different names. Returns a new AnchoredDirTree where failures were -- lifted into a `Failed` constructor: -writeDirectory :: AnchoredDirTree String -> IO (AnchoredDirTree ()) +-- TODO version not specialized to FilePath? +writeDirectory :: AnchoredDirTree FilePath String -> IO (AnchoredDirTree FilePath ()) writeDirectory = writeDirectoryWith writeFile @@ -346,12 +369,12 @@ writeDirectory = writeDirectoryWith writeFile -- become the new `contents` of the returned, where IO errors at each node are -- replaced with `Failed` constructors. The returned tree can be compared to -- the passed tree to see what operations, if any, failed: -writeDirectoryWith :: (FilePath -> a -> IO b) -> AnchoredDirTree a -> IO (AnchoredDirTree b) +writeDirectoryWith :: IsName n => (FilePath -> a -> IO b) -> AnchoredDirTree n a -> IO (AnchoredDirTree n b) writeDirectoryWith f (b:/t) = (b:/) <$> write' b t where write' b' (File n a) = handleDT n $ - File n <$> f (b'n) a + File n <$> f (nappend b' n) a write' b' (Dir n cs) = handleDT n $ - do let bas = b'n + do let bas = nappend b' n createDirectoryIfMissing True bas Dir n <$> mapM (write' bas) cs write' _ (Failed n e) = return $ Failed n e @@ -367,7 +390,8 @@ writeDirectoryWith f (b:/t) = (b:/) <$> write' b t -- | a simple application of readDirectoryWith openFile: -openDirectory :: FilePath -> IOMode -> IO (AnchoredDirTree Handle) +-- TODO version not specialized to FilePath? +openDirectory :: FilePath -> IOMode -> IO (AnchoredDirTree FilePath Handle) openDirectory p m = readDirectoryWith (flip openFile m) p @@ -376,13 +400,13 @@ openDirectory p m = readDirectoryWith (flip openFile m) p -- the base directory in the Anchored* wrapper. Errors are caught in the tree in -- the Failed constructor. The 'file' fields initially are populated with full -- paths to the files they are abstracting. -build :: FilePath -> IO (AnchoredDirTree FilePath) +build :: IsName n => FilePath -> IO (AnchoredDirTree n FilePath) build = buildWith' buildAtOnce' return -- we say 'return' here to get -- back a tree of FilePaths -- | identical to `build` but does directory reading IO lazily as needed: -buildL :: FilePath -> IO (AnchoredDirTree FilePath) +buildL :: IsName n => FilePath -> IO (AnchoredDirTree n FilePath) buildL = buildWith' buildLazilyUnsafe' return @@ -392,11 +416,11 @@ buildL = buildWith' buildLazilyUnsafe' return type UserIO a = FilePath -> IO a -type Builder a = UserIO a -> FilePath -> IO (DirTree a) +type Builder n a = UserIO a -> FilePath -> IO (DirTree n a) -- remove non-existent file errors, which are artifacts of the "non-atomic" -- nature of traversing a system directory tree: -buildWith' :: Builder a -> UserIO a -> FilePath -> IO (AnchoredDirTree a) +buildWith' :: IsName n => Builder n a -> UserIO a -> FilePath -> IO (AnchoredDirTree n a) buildWith' bf' f p = do tree <- bf' f p return (baseDir p :/ removeNonexistent tree) @@ -404,14 +428,14 @@ buildWith' bf' f p = -- IO function passed to our builder and finally executed here: -buildAtOnce' :: Builder a +buildAtOnce' :: IsName n => Builder n a buildAtOnce' f p = handleDT n $ do isFile <- doesFileExist p if isFile then File n <$> f p else do cs <- getDirsFiles p Dir n <$> T.mapM (buildAtOnce' f . combine p) cs - where n = topDir p + where n = p2n $ topDir p unsafeMapM :: (a -> IO b) -> [a] -> IO [b] @@ -425,7 +449,7 @@ unsafeMapM f (x:xs) = unsafeInterleaveIO io -- using unsafeInterleaveIO to get "lazy" traversal: -buildLazilyUnsafe' :: Builder a +buildLazilyUnsafe' :: IsName n => Builder n a buildLazilyUnsafe' f p = handleDT n $ do isFile <- doesFileExist p if isFile @@ -438,7 +462,7 @@ buildLazilyUnsafe' f p = handleDT n $ return (Dir n dirTrees) where rec = buildLazilyUnsafe' f - n = topDir p + n = p2n $ topDir p @@ -453,27 +477,27 @@ buildLazilyUnsafe' f p = handleDT n $ -- | True if any Failed constructors in the tree -anyFailed :: DirTree a -> Bool +anyFailed :: DirTree n a -> Bool anyFailed = not . successful -- | True if there are no Failed constructors in the tree -successful :: DirTree a -> Bool +successful :: DirTree n a -> Bool successful = null . failures -- | returns true if argument is a `Failed` constructor: -failed :: DirTree a -> Bool +failed :: DirTree n a -> Bool failed (Failed _ _) = True failed _ = False -- | returns a list of 'Failed' constructors only: -failures :: DirTree a -> [DirTree a] +failures :: DirTree n a -> [DirTree n a] failures = filter failed . flattenDir -- | maps a function to convert Failed DirTrees to Files or Dirs -failedMap :: (FileName -> IOException -> DirTree a) -> DirTree a -> DirTree a +failedMap :: IsName n => (n -> IOException -> DirTree n a) -> DirTree n a -> DirTree n a failedMap f = transformDir unFail where unFail (Failed n e) = f n e unFail c = c @@ -483,16 +507,16 @@ failedMap f = transformDir unFail -- | Recursively sort a directory tree according to the Ord instance -sortDir :: (Ord a)=> DirTree a -> DirTree a +sortDir :: (Ord n, Ord a)=> DirTree n a -> DirTree n a sortDir = sortDirBy compare -- | Recursively sort a tree as in `sortDir` but ignore the file contents of a -- File constructor -sortDirShape :: DirTree a -> DirTree a +sortDirShape :: (Ord n) => DirTree n a -> DirTree n a sortDirShape = sortDirBy comparingShape where -- HELPER: -sortDirBy :: (DirTree a -> DirTree a -> Ordering) -> DirTree a -> DirTree a +sortDirBy :: (Ord n) => (DirTree n a -> DirTree n a -> Ordering) -> DirTree n a -> DirTree n a sortDirBy cf = transformDir sortD where sortD (Dir n cs) = Dir n (sortBy cf cs) sortD c = c @@ -500,13 +524,13 @@ sortDirBy cf = transformDir sortD -- | Tests equality of two trees, ignoring their free variable portion. Can be -- used to check if any files have been added or deleted, for instance. -equalShape :: DirTree a -> DirTree b -> Bool +equalShape :: (Eq n, Ord n) => DirTree n a -> DirTree n b -> Bool equalShape d d' = comparingShape d d' == EQ -- TODO: we should use equalFilePath here, but how to sort properly? with System.Directory.canonicalizePath, before compare? -- | a compare function that ignores the free "file" type variable: -comparingShape :: DirTree a -> DirTree b -> Ordering +comparingShape :: (Eq n, Ord n) => DirTree n a -> DirTree n b -> Ordering comparingShape (Dir n cs) (Dir n' cs') = case compare n n' of EQ -> comp (sortCs cs) (sortCs cs') @@ -524,7 +548,8 @@ comparingShape t t' = comparingConstr t t' -- HELPER: a non-recursive comparison -comparingConstr :: DirTree a -> DirTree a1 -> Ordering +-- TODO should the constraint here be IsName n? +comparingConstr :: (Eq n, Ord n) => DirTree n a -> DirTree n a1 -> Ordering comparingConstr (Failed _ _) (Dir _ _) = LT comparingConstr (Failed _ _) (File _ _) = LT comparingConstr (File _ _) (Failed _ _) = GT @@ -542,16 +567,16 @@ comparingConstr t t' = compare (name t) (name t') {-# DEPRECATED free "Use record 'dirTree'" #-} -- | DEPRECATED. Use record 'dirTree' instead. -free :: AnchoredDirTree a -> DirTree a +free :: AnchoredDirTree n a -> DirTree n a free = dirTree -- | If the argument is a 'Dir' containing a sub-DirTree matching 'FileName' -- then return that subtree, appending the 'name' of the old root 'Dir' to the -- 'anchor' of the AnchoredDirTree wrapper. Otherwise return @Nothing@. -dropTo :: FileName -> AnchoredDirTree a -> Maybe (AnchoredDirTree a) +dropTo :: IsName n => n -> AnchoredDirTree n a -> Maybe (AnchoredDirTree n a) dropTo n' (p :/ Dir n ds') = search ds' where search [] = Nothing - search (d:ds) | equalFilePath n' (name d) = Just ((pn) :/ d) + search (d:ds) | equalFilePath (n2p n') (n2p $ name d) = Just (nappend p n :/ d) | otherwise = search ds dropTo _ _ = Nothing @@ -559,7 +584,7 @@ dropTo _ _ = Nothing -- | applies the predicate to each constructor in the tree, removing it (and -- its children, of course) when the predicate returns False. The topmost -- constructor will always be preserved: -filterDir :: (DirTree a -> Bool) -> DirTree a -> DirTree a +filterDir :: (DirTree n a -> Bool) -> DirTree n a -> DirTree n a filterDir p = transformDir filterD where filterD (Dir n cs) = Dir n $ filter p cs filterD c = c @@ -567,7 +592,7 @@ filterDir p = transformDir filterD -- | Flattens a `DirTree` into a (never empty) list of tree constructors. `Dir` -- constructors will have [] as their `contents`: -flattenDir :: DirTree a -> [ DirTree a ] +flattenDir :: DirTree n a -> [ DirTree n a ] flattenDir (Dir n cs) = Dir n [] : concatMap flattenDir cs flattenDir f = [f] @@ -577,8 +602,8 @@ flattenDir f = [f] -- | Allows for a function on a bare DirTree to be applied to an AnchoredDirTree -- within a Functor. Very similar to and useful in combination with `<$>`: -() :: (Functor f) => (DirTree a -> DirTree b) -> f (AnchoredDirTree a) -> - f (AnchoredDirTree b) +() :: (Functor f) => (DirTree n a -> DirTree n b) -> f (AnchoredDirTree n a) -> + f (AnchoredDirTree n b) () f = fmap (\(b :/ t) -> b :/ f t) @@ -589,11 +614,11 @@ flattenDir f = [f] ---- CONSTRUCTOR IDENTIFIERS ---- {- -isFileC :: DirTree a -> Bool +isFileC :: DirTree n a -> Bool isFileC (File _ _) = True isFileC _ = False -isDirC :: DirTree a -> Bool +isDirC :: DirTree n a -> Bool isDirC (Dir _ _) = True isDirC _ = False -} @@ -609,10 +634,10 @@ isDirC _ = False -- -- This allows us to, for example, @mapM_ uncurry writeFile@ over a DirTree of -- strings, although 'writeDirectory' does a better job of this. -zipPaths :: AnchoredDirTree a -> DirTree (FilePath, a) +zipPaths :: IsName n => AnchoredDirTree n a -> DirTree n (FilePath, a) zipPaths (b :/ t) = zipP b t - where zipP p (File n a) = File n (pn , a) - zipP p (Dir n cs) = Dir n $ map (zipP $ pn) cs + where zipP p (File n a) = File n (nappend p n, a) + zipP p (Dir n cs) = Dir n $ map (zipP $ nappend p n) cs zipP _ (Failed n e) = Failed n e @@ -629,7 +654,7 @@ baseDir = joinPath . init . splitDirectories -- | writes the directory structure (not files) of a DirTree to the anchored -- directory. Returns a structure identical to the supplied tree with errors -- replaced by `Failed` constructors: -writeJustDirs :: AnchoredDirTree a -> IO (AnchoredDirTree a) +writeJustDirs :: IsName n => AnchoredDirTree n a -> IO (AnchoredDirTree n a) writeJustDirs = writeDirectoryWith (const return) @@ -649,7 +674,7 @@ getDirsFiles cs = do let cs' = if null cs then "." else cs -- handles an IO exception by returning a Failed constructor filled with that -- exception: -handleDT :: FileName -> IO (DirTree a) -> IO (DirTree a) +handleDT :: IsName n => n -> IO (DirTree n a) -> IO (DirTree n a) handleDT n = handle (return . Failed n) @@ -659,7 +684,7 @@ handleDT n = handle (return . Failed n) -- So we filter those errors out because the user should not see errors -- raised by the internal implementation of this module: -- This leaves the error if it exists in the top (user-supplied) level: -removeNonexistent :: DirTree a -> DirTree a +removeNonexistent :: DirTree n a -> DirTree n a removeNonexistent = filterDir isOkConstructor where isOkConstructor c = not (failed c) || isOkError c isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err @@ -668,7 +693,7 @@ removeNonexistent = filterDir isOkConstructor -- | At 'Dir' constructor, apply transformation function to all of directory's -- contents, then remove the Nothing's and recurse. This always preserves the -- topomst constructor. -transformDir :: (DirTree a -> DirTree a) -> DirTree a -> DirTree a +transformDir :: (DirTree n a -> DirTree n a) -> DirTree n a -> DirTree n a transformDir f t = case f t of (Dir n cs) -> Dir n $ map (transformDir f) cs t' -> t' @@ -676,68 +701,68 @@ transformDir f t = case f t of -- Lenses, generated with TH from "lens" ----------- -- TODO deprecate these? Pain in the ass to generate, and maybe it's intended -- for users to generate their own lenses. -_contents :: - Applicative f => - ([DirTree a] -> f [DirTree a]) -> DirTree a -> f (DirTree a) - -_err :: - Applicative f => - (IOException -> f IOException) -> DirTree a -> f (DirTree a) - -_file :: - Applicative f => - (a -> f a) -> DirTree a -> f (DirTree a) - -_name :: - Functor f => - (FileName -> f FileName) -> DirTree a -> f (DirTree a) - -_anchor :: - Functor f => - (FilePath -> f FilePath) - -> AnchoredDirTree a -> f (AnchoredDirTree a) - -_dirTree :: - Functor f => - (DirTree t -> f (DirTree a)) - -> AnchoredDirTree t -> f (AnchoredDirTree a) - ---makeLensesFor [("name","_name"),("err","_err"),("contents","_contents"),("file","_file")] ''DirTree -_contents _f_a6s2 (Failed _name_a6s3 _err_a6s4) - = pure (Failed _name_a6s3 _err_a6s4) -_contents _f_a6s5 (Dir _name_a6s6 _contents'_a6s7) - = ((\ _contents_a6s8 -> Dir _name_a6s6 _contents_a6s8) - <$> (_f_a6s5 _contents'_a6s7)) -_contents _f_a6s9 (File _name_a6sa _file_a6sb) - = pure (File _name_a6sa _file_a6sb) -_err _f_a6sd (Failed _name_a6se _err'_a6sf) - = ((\ _err_a6sg -> Failed _name_a6se _err_a6sg) - <$> (_f_a6sd _err'_a6sf)) -_err _f_a6sh (Dir _name_a6si _contents_a6sj) - = pure (Dir _name_a6si _contents_a6sj) -_err _f_a6sk (File _name_a6sl _file_a6sm) - = pure (File _name_a6sl _file_a6sm) -_file _f_a6so (Failed _name_a6sp _err_a6sq) - = pure (Failed _name_a6sp _err_a6sq) -_file _f_a6sr (Dir _name_a6ss _contents_a6st) - = pure (Dir _name_a6ss _contents_a6st) -_file _f_a6su (File _name_a6sv _file'_a6sw) - = ((\ _file_a6sx -> File _name_a6sv _file_a6sx) - <$> (_f_a6su _file'_a6sw)) -_name _f_a6sz (Failed _name'_a6sA _err_a6sC) - = ((\ _name_a6sB -> Failed _name_a6sB _err_a6sC) - <$> (_f_a6sz _name'_a6sA)) -_name _f_a6sD (Dir _name'_a6sE _contents_a6sG) - = ((\ _name_a6sF -> Dir _name_a6sF _contents_a6sG) - <$> (_f_a6sD _name'_a6sE)) -_name _f_a6sH (File _name'_a6sI _file_a6sK) - = ((\ _name_a6sJ -> File _name_a6sJ _file_a6sK) - <$> (_f_a6sH _name'_a6sI)) - ---makeLensesFor [("anchor","_anchor"),("dirTree","_dirTree")] ''AnchoredDirTree -_anchor _f_a7wT (_anchor'_a7wU :/ _dirTree_a7wW) - = ((\ _anchor_a7wV -> (:/) _anchor_a7wV _dirTree_a7wW) - <$> (_f_a7wT _anchor'_a7wU)) -_dirTree _f_a7wZ (_anchor_a7x0 :/ _dirTree'_a7x1) - = ((\ _dirTree_a7x2 -> (:/) _anchor_a7x0 _dirTree_a7x2) - <$> (_f_a7wZ _dirTree'_a7x1)) +-- _contents :: +-- Applicative f => +-- ([DirTree n a] -> f [DirTree n a]) -> DirTree n a -> f (DirTree n a) +-- +-- _err :: +-- Applicative f => +-- (IOException -> f IOException) -> DirTree n a -> f (DirTree n a) +-- +-- _file :: +-- Applicative f => +-- (a -> f a) -> DirTree n a -> f (DirTree n a) +-- +-- _name :: +-- Functor f => +-- (FileName -> f FileName) -> DirTree n a -> f (DirTree n a) +-- +-- _anchor :: +-- Functor f => +-- (FilePath -> f FilePath) +-- -> AnchoredDirTree n a -> f (AnchoredDirTree n a) +-- +-- _dirTree :: +-- Functor f => +-- (DirTree n t -> f (DirTree n a)) +-- -> AnchoredDirTree n t -> f (AnchoredDirTree n a) +-- +-- --makeLensesFor [("name","_name"),("err","_err"),("contents","_contents"),("file","_file")] ''DirTree +-- _contents _f_a6s2 (Failed _name_a6s3 _err_a6s4) +-- = pure (Failed _name_a6s3 _err_a6s4) +-- _contents _f_a6s5 (Dir _name_a6s6 _contents'_a6s7) +-- = ((\ _contents_a6s8 -> Dir _name_a6s6 _contents_a6s8) +-- <$> (_f_a6s5 _contents'_a6s7)) +-- _contents _f_a6s9 (File _name_a6sa _file_a6sb) +-- = pure (File _name_a6sa _file_a6sb) +-- _err _f_a6sd (Failed _name_a6se _err'_a6sf) +-- = ((\ _err_a6sg -> Failed _name_a6se _err_a6sg) +-- <$> (_f_a6sd _err'_a6sf)) +-- _err _f_a6sh (Dir _name_a6si _contents_a6sj) +-- = pure (Dir _name_a6si _contents_a6sj) +-- _err _f_a6sk (File _name_a6sl _file_a6sm) +-- = pure (File _name_a6sl _file_a6sm) +-- _file _f_a6so (Failed _name_a6sp _err_a6sq) +-- = pure (Failed _name_a6sp _err_a6sq) +-- _file _f_a6sr (Dir _name_a6ss _contents_a6st) +-- = pure (Dir _name_a6ss _contents_a6st) +-- _file _f_a6su (File _name_a6sv _file'_a6sw) +-- = ((\ _file_a6sx -> File _name_a6sv _file_a6sx) +-- <$> (_f_a6su _file'_a6sw)) +-- _name _f_a6sz (Failed _name'_a6sA _err_a6sC) +-- = ((\ _name_a6sB -> Failed _name_a6sB _err_a6sC) +-- <$> (_f_a6sz _name'_a6sA)) +-- _name _f_a6sD (Dir _name'_a6sE _contents_a6sG) +-- = ((\ _name_a6sF -> Dir _name_a6sF _contents_a6sG) +-- <$> (_f_a6sD _name'_a6sE)) +-- _name _f_a6sH (File _name'_a6sI _file_a6sK) +-- = ((\ _name_a6sJ -> File _name_a6sJ _file_a6sK) +-- <$> (_f_a6sH _name'_a6sI)) +-- +-- --makeLensesFor [("anchor","_anchor"),("dirTree","_dirTree")] ''AnchoredDirTree +-- _anchor _f_a7wT (_anchor'_a7wU :/ _dirTree_a7wW) +-- = ((\ _anchor_a7wV -> (:/) _anchor_a7wV _dirTree_a7wW) +-- <$> (_f_a7wT _anchor'_a7wU)) +-- _dirTree _f_a7wZ (_anchor_a7x0 :/ _dirTree'_a7x1) +-- = ((\ _dirTree_a7x2 -> (:/) _anchor_a7x0 _dirTree_a7x2) +-- <$> (_f_a7wZ _dirTree'_a7x1)) diff --git a/Test.hs b/Test.hs index ebdc932..a15294e 100644 --- a/Test.hs +++ b/Test.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module Main where @@ -58,7 +60,7 @@ main = do -- run lazy fold, concating file contents. compare for equality: - tL_again <- sortDir readDirectoryWithL readFile testDir + (tL_again :: AnchoredDirTree FilePath String) <- sortDir readDirectoryWithL readFile testDir let tL_concated = F.concat $ dirTree tL_again if tL_concated == "abcdef" then return () else error "foldable broke" putStrLn "OK" @@ -71,9 +73,9 @@ main = do putStrLn "\nOK" - let undefinedOrdFailed = Failed undefined undefined :: DirTree Char - undefinedOrdDir = Dir undefined undefined :: DirTree Char - undefinedOrdFile = File undefined undefined :: DirTree Char + let undefinedOrdFailed = Failed undefined undefined :: DirTree FilePath Char + undefinedOrdDir = Dir undefined undefined :: DirTree FilePath Char + undefinedOrdFile = File undefined undefined :: DirTree FilePath Char -- simple equality and sorting if Dir "d" [File "b" "b",File "a" "a"] == Dir "d" [File "a" "a", File "b" "b"] && -- recursive sort order, enforces non-recursive sorting of Dirs @@ -139,7 +141,7 @@ main = do <> "directories, but tree string " <> dirsOnlyTestStr <> "has " <> (show dirsInStringCount) -testTree :: AnchoredDirTree String +testTree :: AnchoredDirTree FilePath String testTree = "" :/ Dir testDir [dA , dB , dC , Failed "FAAAIIILL" undefined] where dA = Dir "A" [dA1 , dA2 , Failed "FAIL" undefined] dA1 = Dir "A1" [File "A" "a", File "B" "b"] diff --git a/flake.lock b/flake.lock index c0ecefd..953b7c2 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1681202837, - "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", + "lastModified": 1710146030, + "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=", "owner": "numtide", "repo": "flake-utils", - "rev": "cfacdce06f30d2b68473a46042957675eebb3401", + "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a", "type": "github" }, "original": { @@ -20,11 +20,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1682879489, - "narHash": "sha256-sASwo8gBt7JDnOOstnps90K1wxmVfyhsTPPNTGBPjjg=", + "lastModified": 1714076141, + "narHash": "sha256-Drmja/f5MRHZCskS6mvzFqxEaZMeciScCTFxWVLqWEY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "da45bf6ec7bbcc5d1e14d3795c025199f28e0de0", + "rev": "7bb2ccd8cdc44c91edba16c48d2c8f331fb3d856", "type": "github" }, "original": { diff --git a/todo.txt b/todo.txt new file mode 100644 index 0000000..9e697b3 --- /dev/null +++ b/todo.txt @@ -0,0 +1,8 @@ +clean up the TreeName typeclass: + rename IsFileName, toFileName, fromFileName? + rename joinFileNames, and maybe add an infix version + +use Sequence for the anchors: + https://hackage.haskell.org/package/containers-0.7/docs/Data-Sequence.html + https://stackoverflow.com/a/5188681 + makes anchor lists strict, but i think we would always want that anyway?