packages feed

path-tagged (empty) → 0.1.0.0

raw patch · 9 files changed

+1103/−0 lines, 9 filesdep +aesondep +basedep +deepseqsetup-changed

Dependencies added: aeson, base, deepseq, exceptions, hashable, path, path-io, tasty, template-haskell, th-compat, time

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog for `path-tagged`++## 0.1.0.0 - 2024-03-05++Initial Release :tada:
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Hiromi ISHII (c) 2023++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Hiromi ISHII nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,12 @@+# path-tagged - thin wrapper around `path` library augmented with the target entity++This package provides a thin wrapper type `PathTo entity b t` of `Path b t` from [`path`][pathlib] library.++[pathlib]: https://hackage.haskell.org/package/path++The following hopefully describes the image:++```hs+(</>) :: PathTo e b Dir -> PathTo e' (RelTo e) t -> PathTo e' b t+parent :: PathTo e b t -> PathTo (Parent e) b Dir+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ path-tagged.cabal view
@@ -0,0 +1,81 @@+cabal-version: 3.0+name: path-tagged+version: 0.1.0.0+category: System, Filesystem+synopsis: A wrapper around the @path@ library, tagged with semantic name.+description: Please see the README on GitHub at <https://github.com/konn/path-tagged#readme>+homepage: https://github.com/konn/path-tagged#readme+bug-reports: https://github.com/konn/path-tagged/issues+author: Hiromi ISHII+maintainer: konn.jinro_at_gmail.com+copyright: 2023 (c) Hiromi ISHII+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+tested-with: ghc ==9.2.8 || ==9.4.8 || ==9.6.4 || ==9.8.2+extra-doc-files:+  CHANGELOG.md+  README.md++common defaults+  autogen-modules: Paths_path_tagged+  other-modules: Paths_path_tagged+  ghc-options:+    -Wall+    -Wcompat+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-export-lists+    -Wmissing-home-modules+    -Wpartial-fields+    -Wredundant-constraints+    -Wunused-packages++source-repository head+  type: git+  location: https://github.com/konn/path-tagged++library+  import: defaults+  -- cabal-gild: discover src+  exposed-modules:+    Path.Tagged+    Path.Tagged.IO++  hs-source-dirs: src+  build-depends:+    aeson,+    base >=4.7 && <5,+    deepseq,+    exceptions,+    hashable,+    path,+    path-io,+    template-haskell,+    th-compat,+    time,++  default-language: Haskell2010++test-suite path-tagged-test+  import: defaults+  type: exitcode-stdio-1.0+  main-is: Test.hs+  -- cabal-gild: discover test/cases+  other-modules: Cases+  hs-source-dirs:+    test+    test/cases++  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++  build-tool-depends: tasty-discover:tasty-discover+  build-depends:+    base >=4.7 && <5,+    tasty,++  default-language: Haskell2010
+ src/Path/Tagged.hs view
@@ -0,0 +1,379 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Path.Tagged (+  -- * Types+  PathTo (..),+  ToSubpath,+  retagPath,+  Base (..),+  Untag,+  Abs,+  RelTo,+  File,+  Dir,++  -- ** Special Entity Tags+  Unknown,+  Subpath (..),+  EntryOf,+  Entry,+  Parent,+  ParentOf,+  SomeBase (..),+  untagSomeBase,++  -- * Exceptions+  PathException (..),++  -- * QuasiQuotes+  absdir,+  reldir,+  absfile,+  relfile,++  -- * Operations+  (</>),+  stripProperPrefix,+  isProperPrefixOf,+  replaceProperPrefix,+  replaceProperPrefix',+  parent,+  filename,+  dirname,+  addExtension,+  splitExtension,+  fileExtension,+  replaceExtension,+  mapSomeBase,+  prjSomeBase,++  -- * Parsing+  parseAbsDir,+  parseRelDir,+  parseAbsFile,+  parseRelFile,+  parseSomeDir,+  parseSomeFile,++  -- * Conversion+  toFilePath,+  fromAbsDir,+  fromRelDir,+  fromAbsFile,+  fromRelFile,+  fromSomeDir,+  fromSomeFile,++  -- * TemplateHaskell constructors+  mkAbsDir,+  mkRelDir,+  mkAbsFile,+  mkRelFile,++  -- ** Typed constructors+  mkAbsDirT,+  mkRelDirT,+  mkAbsFileT,+  mkRelFileT,+) where++import Control.DeepSeq (NFData)+import Control.Monad.Catch (MonadThrow)+import Data.Aeson (FromJSON, FromJSONKey, ToJSON, Value)+import qualified Data.Aeson.Types as J+import qualified Data.Bifunctor as Bi+import Data.Coerce (coerce)+import Data.Functor ((<&>))+import Data.Hashable (Hashable)+import Data.Kind (Type)+import Data.Maybe (isJust)+import GHC.Generics (Generic)+import GHC.TypeLits+import Language.Haskell.TH (ExpQ)+import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Language.Haskell.TH.Syntax (Lift)+import Language.Haskell.TH.Syntax.Compat+import Path (Dir, File, PathException)+import qualified Path as P+import Type.Reflection (Typeable)++type role PathTo phantom nominal nominal++type PathTo :: forall {k}. k -> Base k -> Type -> Type+newtype PathTo entity pk t = PathTo {untagPath :: P.Path (Untag pk) t}+  deriving (Generic)+  deriving newtype (Eq, Ord, Show, Hashable, ToJSON, NFData)++deriving instance (Typeable t, Typeable (Untag b)) => Lift (PathTo e b t)++-- | Unknown base directory+type Unknown :: k+type family Unknown where++type EntryOf :: forall {k}. Subpath k -> k+type family EntryOf k where+  EntryOf ('Entry e) = e+  EntryOf p = TypeError ('Text "Concrete entry expected, but got: " ':<>: 'ShowType p)++data Subpath k = Entry k | Parent (Subpath k)++type Entry = 'Entry++type Parent = 'Parent++type ParentOf e = 'Parent ('Entry e)++type Retagged' :: forall k k' -> Base k -> Base k'+type family Retagged' k k' bk where+  Retagged' k k a = a+  Retagged' k k' Abs = Abs+  Retagged' k k' (RelTo p) =+    TypeError ('Text "Different kind of path cannot be rettaged with relative base: " ':<>: 'ShowType (RelTo p))++type Retagged :: forall {k} {k'}. Base k -> Base k'+type Retagged (a :: Base k) = Retagged' k k' a :: Base k'++retagPath :: PathTo p b t -> PathTo p' (Retagged b) t+retagPath = coerce++deriving newtype instance FromJSON (PathTo k (RelTo b) File)++deriving newtype instance FromJSON (PathTo k (RelTo b) Dir)++deriving newtype instance FromJSON (PathTo k Abs File)++deriving newtype instance FromJSON (PathTo k Abs Dir)++deriving newtype instance FromJSONKey (PathTo k (RelTo b) File)++deriving newtype instance FromJSONKey (PathTo k (RelTo b) Dir)++deriving newtype instance FromJSONKey (PathTo k Abs File)++deriving newtype instance FromJSONKey (PathTo k Abs Dir)++type Untag :: forall {k}. Base k -> Type+type family Untag pk where+  Untag ('RelTo _) = P.Rel+  Untag 'Abs = P.Abs++data Base k = RelTo k | Abs++type RelTo = 'RelTo++type Abs = 'Abs++(</>) :: PathTo parent b Dir -> PathTo child (RelTo parent) t -> PathTo child b t+{-# INLINE (</>) #-}+(</>) = coerce (P.</>)++infixr 5 </>++stripProperPrefix :: (MonadThrow m) => PathTo p b Dir -> PathTo l b t -> m (PathTo l (RelTo p) t)+stripProperPrefix (PathTo p) (PathTo l) = PathTo <$> P.stripProperPrefix p l++isProperPrefixOf :: PathTo p b Dir -> PathTo l b t -> Bool+isProperPrefixOf p l = isJust (stripProperPrefix p l)++replaceProperPrefix ::+  (MonadThrow m) =>+  PathTo parent b Dir ->+  PathTo parent' b' Dir ->+  PathTo child b t ->+  m (PathTo child b' t)+replaceProperPrefix src dst fp = (dst </>) <$> stripProperPrefix (retagPath src) fp++replaceProperPrefix' ::+  (MonadThrow m) =>+  PathTo parent b Dir ->+  PathTo parent b' Dir ->+  PathTo child b t ->+  m (PathTo child b' t)+replaceProperPrefix' src dst fp = (dst </>) <$> stripProperPrefix src fp++type ToSubpath :: forall {k}. Base k -> Base (Subpath k)+type family ToSubpath a where+  ToSubpath 'Abs = 'Abs+  ToSubpath ('RelTo e) = 'RelTo (Entry e)++parent :: PathTo e b t -> PathTo (ParentOf e) (ToSubpath b) Dir+parent = coerce P.parent++filename :: PathTo e b File -> PathTo (Entry e) (RelTo (ParentOf e)) File+filename = coerce P.filename++dirname :: PathTo e b Dir -> PathTo (Entry e) (RelTo (ParentOf e)) Dir+dirname = coerce P.dirname++addExtension :: forall e' m e b. (MonadThrow m) => String -> PathTo e b File -> m (PathTo e' b File)+addExtension ext = fmap PathTo . P.addExtension ext . coerce++splitExtension ::+  forall e' m e b.+  (MonadThrow m) =>+  PathTo e b File ->+  m (PathTo e' b File, String)+splitExtension = fmap (Bi.first PathTo) . P.splitExtension . coerce++fileExtension :: (MonadThrow m) => PathTo e b File -> m String+fileExtension = P.fileExtension . coerce++replaceExtension ::+  forall e' m e b.+  (MonadThrow m) =>+  String ->+  PathTo e b File ->+  m (PathTo e' b File)+replaceExtension ext = fmap PathTo . P.replaceExtension ext . coerce++mapSomeBase :: (forall c. PathTo e c t -> PathTo e' c t') -> SomeBase e b t -> SomeBase e' b t'+mapSomeBase f = \case+  IsAbs fp -> IsAbs (f fp)+  IsRel fp -> IsRel (f fp)++prjSomeBase :: (forall c. PathTo e c t -> a) -> SomeBase e b t -> a+prjSomeBase f = \case+  IsAbs fp -> f fp+  IsRel fp -> f fp++parseAbsDir :: forall e m. (MonadThrow m) => FilePath -> m (PathTo e Abs Dir)+parseAbsDir = fmap coerce . P.parseAbsDir++parseRelDir :: forall e b m. (MonadThrow m) => FilePath -> m (PathTo e (RelTo b) Dir)+parseRelDir = fmap coerce . P.parseRelDir++parseAbsFile :: forall e m. (MonadThrow m) => FilePath -> m (PathTo e Abs File)+parseAbsFile = fmap coerce . P.parseAbsFile++parseRelFile :: forall e b m. (MonadThrow m) => FilePath -> m (PathTo e (RelTo b) File)+parseRelFile = fmap coerce . P.parseRelFile++parseSomeDir :: (MonadThrow m) => FilePath -> m (SomeBase e b Dir)+{-# INLINE parseSomeDir #-}+parseSomeDir fp =+  P.parseSomeDir fp <&> \case+    P.Abs p -> IsAbs $ PathTo p+    P.Rel p -> IsRel $ PathTo p++parseSomeFile :: (MonadThrow m) => FilePath -> m (SomeBase e b File)+{-# INLINE parseSomeFile #-}+parseSomeFile fp =+  P.parseSomeFile fp <&> \case+    P.Abs p -> IsAbs $ PathTo p+    P.Rel p -> IsRel $ PathTo p++data SomeBase e b t+  = IsAbs (PathTo e Abs t)+  | IsRel (PathTo e (RelTo b) t)+  deriving (Show, Eq, Ord, Generic)+  deriving anyclass (NFData, Hashable)++instance FromJSON (SomeBase e b Dir) where+  parseJSON = parseJSONWith parseSomeDir+  {-# INLINE parseJSON #-}++instance FromJSON (SomeBase e b File) where+  parseJSON = parseJSONWith parseSomeFile+  {-# INLINE parseJSON #-}++instance ToJSON (SomeBase e b t) where+  toJSON = J.toJSON . prjSomeBase toFilePath++parseJSONWith ::+  (Show e, FromJSON a) =>+  (a -> Either e b) ->+  Value ->+  J.Parser b+parseJSONWith f x =+  do+    fp <- J.parseJSON x+    case f fp of+      Right p -> return p+      Left e -> fail (show e)+{-# INLINE parseJSONWith #-}++untagSomeBase :: SomeBase e b t -> P.SomeBase t+untagSomeBase (IsAbs (PathTo fp)) = P.Abs fp+untagSomeBase (IsRel (PathTo fp)) = P.Rel fp++wrapE :: (FilePath -> ExpQ) -> FilePath -> ExpQ+wrapE e fp = [|PathTo $(e fp)|]++wrapPathQQ :: QuasiQuoter -> QuasiQuoter+wrapPathQQ qq = qq {quoteExp = wrapE (quoteExp qq)}++relfile :: QuasiQuoter+relfile = wrapPathQQ P.relfile++absfile :: QuasiQuoter+absfile = wrapPathQQ P.absfile++reldir :: QuasiQuoter+reldir = wrapPathQQ P.reldir++absdir :: QuasiQuoter+absdir = wrapPathQQ P.absdir++toFilePath :: PathTo e b t -> FilePath+toFilePath = coerce P.toFilePath++fromAbsDir :: PathTo e Abs Dir -> FilePath+fromAbsDir = P.fromAbsDir . untagPath++fromRelDir :: PathTo e (RelTo b) Dir -> FilePath+fromRelDir = P.fromRelDir . untagPath++fromAbsFile :: PathTo e Abs File -> FilePath+fromAbsFile = P.fromAbsFile . untagPath++fromRelFile :: PathTo e (RelTo b) File -> FilePath+fromRelFile = P.fromRelFile . untagPath++fromSomeDir :: SomeBase e b Dir -> FilePath+fromSomeDir = prjSomeBase toFilePath++fromSomeFile :: SomeBase e b File -> FilePath+fromSomeFile = prjSomeBase toFilePath++mkAbsDir :: FilePath -> ExpQ+mkAbsDir = wrapE mkAbsDir++mkRelDir :: FilePath -> ExpQ+mkRelDir = wrapE mkRelDir++mkAbsFile :: FilePath -> ExpQ+mkAbsFile = wrapE mkAbsFile++mkRelFile :: FilePath -> ExpQ+mkRelFile = wrapE mkRelFile++mkAbsDirT :: FilePath -> SpliceQ (PathTo e Abs Dir)+mkAbsDirT = unsafeSpliceCoerce . mkAbsDir++mkRelDirT :: FilePath -> SpliceQ (PathTo e (RelTo b) Dir)+mkRelDirT = unsafeSpliceCoerce . mkAbsDir++mkAbsFileT :: FilePath -> SpliceQ (PathTo e Abs File)+mkAbsFileT = unsafeSpliceCoerce . mkAbsFile++mkRelFileT :: FilePath -> SpliceQ (PathTo e (RelTo b) File)+mkRelFileT = unsafeSpliceCoerce . mkAbsFile
+ src/Path/Tagged/IO.hs view
@@ -0,0 +1,590 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Path.Tagged.IO (+  -- * Actions on directories+  createDir,+  createDirIfMissing,+  ensureDir,+  removeDir,+  removeDirRecur,+  removePathForcibly,+  renameDir,+  renamePath,+  listDir,+  listDirRel,+  listDirRecur,+  listDirRecurRel,+  copyDirRecur,+  copyDirRecur',++  -- * Walking directory trees+  WalkAction (..),+  walkDir,+  walkDirRel,+  walkDirAccum,+  walkDirAccumRel,++  -- * Current working directory+  getCurrentDir,+  setCurrentDir,+  withCurrentDir,++  -- * Pre-defined directories+  PredefinedDir (..),+  WithPredefined,+  Cwd,+  Home,+  AppUserData,+  UserDocs,+  TempDir,+  getHomeDir,+  getAppUserDataDir,+  getUserDocsDir,+  getTempDir,+  XdgDirectory (..),+  XdgData,+  XdgConfig,+  XdgCache,+  WithXdg,+  KnownXdgDirectory (),+  getXdgBaseDir,+  getXdgDir,+  getXdgDataDirs,+  getXdgConfigDirs,++  -- * Path transformation+  AnyPathTo (..),+  RelPathTo,+  resolveFile,+  resolveFile',+  resolveDir,+  resolveDir',++  -- * Actions on Files+  removeFile,+  renameFile,+  copyFile,+  getFileSize,+  findExecutable,+  findFile,+  findFiles,+  findFilesWith,++  -- * Symbolic links+  createFileLink,+  createDirLink,+  removeDirLink,+  getSymlinkTarget,+  isSymlink,++  -- * Temporary files and directories+  withTempFile,+  withTempDir,+  withSystemTempFile,+  withSystemTempDir,+  openTempFile,+  openBinaryTempFile,+  createTempDir,++  -- * Existence tests+  doesPathExist,+  doesFileExist,+  doesDirExist,+  isLocationOccupied,+  forgivingAbsence,+  ignoringAbsence,++  -- * Permissions+  Permissions (..),+  emptyPermissions,+  getPermissions,+  setPermissions,+  copyPermissions,++  -- * Timestamps+  getAccessTime,+  setAccessTime,+  getModificationTime,+  setModificationTime,+) where++import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)+import Control.Monad.IO.Class (MonadIO)+import Data.Coerce (coerce)+import Data.Functor ((<&>))+import Data.Kind (Constraint, Type)+import Data.Time (UTCTime)+import GHC.Exts (Proxy#, proxy#)+import GHC.Generics (Generic)+import Path.IO (Permissions (..), XdgDirectory (..), emptyPermissions, forgivingAbsence, ignoringAbsence)+import qualified Path.IO as P+import Path.Tagged+import System.IO (Handle)++createDir :: (MonadIO m) => PathTo e b Dir -> m ()+createDir = P.createDir . coerce++createDirIfMissing :: (MonadIO m) => Bool -> PathTo e b Dir -> m ()+createDirIfMissing p = P.createDirIfMissing p . coerce++ensureDir :: (MonadIO m) => PathTo e b Dir -> m ()+ensureDir = P.ensureDir . coerce++removeDir :: (MonadIO m) => PathTo entity b Dir -> m ()+removeDir = P.removeDir . untagPath++removeDirRecur :: (MonadIO m) => PathTo entity b Dir -> m ()+removeDirRecur = P.removeDirRecur . untagPath++removePathForcibly :: (MonadIO m) => PathTo e b t -> m ()+removePathForcibly = P.removePathForcibly . untagPath++renameDir :: (MonadIO m) => PathTo e b Dir -> PathTo e b' Dir -> m ()+renameDir (PathTo old) (PathTo new) = P.renameDir old new++renamePath :: (MonadIO m) => PathTo e b t -> PathTo e b' t -> m ()+renamePath (PathTo old) (PathTo new) = P.renamePath old new++listDir ::+  (MonadIO m) =>+  PathTo e b Dir ->+  m ([PathTo Unknown Abs Dir], [PathTo Unknown Abs File])+listDir = fmap coerce . P.listDir . untagPath++listDirRel ::+  (MonadIO m) =>+  PathTo e b Dir ->+  m ([PathTo Unknown (RelTo e) Dir], [PathTo Unknown (RelTo e) File])+listDirRel = fmap coerce . P.listDirRel . untagPath++listDirRecur ::+  (MonadIO m) =>+  PathTo e b Dir ->+  m ([PathTo Unknown Abs Dir], [PathTo Unknown Abs File])+listDirRecur = fmap coerce . P.listDirRecur . untagPath++listDirRecurRel ::+  (MonadIO m) =>+  PathTo e b Dir ->+  m ([PathTo Unknown (RelTo e) Dir], [PathTo Unknown (RelTo e) File])+listDirRecurRel = fmap coerce . P.listDirRecurRel . untagPath++copyDirRecur ::+  (MonadIO m, MonadCatch m) =>+  PathTo e0 b0 Dir ->+  PathTo e1 b1 Dir ->+  m ()+copyDirRecur (PathTo p) (PathTo l) = P.copyDirRecur p l++copyDirRecur' ::+  (MonadIO m, MonadCatch m) =>+  PathTo e0 b0 Dir ->+  PathTo e1 b1 Dir ->+  m ()+copyDirRecur' (PathTo p) (PathTo l) = P.copyDirRecur' p l++data WalkAction b = WalkFinish | WalkExclude [PathTo Unknown b Dir]+  deriving (Show, Eq, Ord)++toUntaggedAct :: WalkAction b -> P.WalkAction (Untag b)+{-# INLINE toUntaggedAct #-}+toUntaggedAct WalkFinish = P.WalkFinish+toUntaggedAct (WalkExclude excs) = P.WalkExclude $ coerce excs++walkDir ::+  (MonadIO m) =>+  ( forall dir.+    PathTo dir Abs Dir ->+    [PathTo Unknown Abs Dir] ->+    [PathTo Unknown Abs File] ->+    m (WalkAction Abs)+  ) ->+  PathTo e b Dir ->+  m ()+walkDir f p =+  P.walkDir+    ( \dir subdir subfile -> toUntaggedAct <$> f (PathTo dir) (PathTo <$> subdir) (PathTo <$> subfile)+    )+    (untagPath p)++walkDirRel ::+  (MonadIO m) =>+  ( forall dir.+    PathTo dir (RelTo e) Dir ->+    [PathTo Unknown (RelTo dir) Dir] ->+    [PathTo Unknown (RelTo dir) File] ->+    m (WalkAction (RelTo dir))+  ) ->+  PathTo e b Dir ->+  m ()+walkDirRel f p =+  P.walkDirRel+    ( \dir subdir subfile -> toUntaggedAct <$> f (PathTo dir) (PathTo <$> subdir) (PathTo <$> subfile)+    )+    (untagPath p)++walkDirAccum ::+  (MonadIO m, Monoid o) =>+  Maybe+    ( forall dir.+      PathTo dir Abs Dir ->+      [PathTo Unknown Abs Dir] ->+      [PathTo Unknown Abs File] ->+      m (WalkAction Abs)+    ) ->+  ( forall dir.+    PathTo dir Abs Dir ->+    [PathTo Unknown Abs Dir] ->+    [PathTo Unknown Abs File] ->+    m o+  ) ->+  PathTo e b Dir ->+  m o+walkDirAccum mf g p =+  P.walkDirAccum+    ( mf <&> \f dir subdir subfile -> toUntaggedAct <$> f (PathTo dir) (coerce subdir) (coerce subfile)+    )+    (\dir subdir subfile -> g (PathTo dir) (coerce subdir) (coerce subfile))+    (untagPath p)++walkDirAccumRel ::+  (MonadIO m, Monoid o) =>+  Maybe+    ( forall dir.+      PathTo dir (RelTo e) Dir ->+      [PathTo Unknown (RelTo dir) Dir] ->+      [PathTo Unknown (RelTo dir) File] ->+      m (WalkAction (RelTo dir))+    ) ->+  ( forall dir.+    PathTo dir (RelTo e) Dir ->+    [PathTo Unknown (RelTo dir) Dir] ->+    [PathTo Unknown (RelTo dir) File] ->+    m o+  ) ->+  PathTo e b Dir ->+  m o+walkDirAccumRel mf g p =+  P.walkDirAccumRel+    ( mf <&> \f dir subdir subfile -> toUntaggedAct <$> f (PathTo dir) (coerce subdir) (coerce subfile)+    )+    (\dir subdir subfile -> g (PathTo dir) (coerce subdir) (coerce subfile))+    (untagPath p)++getCurrentDir :: forall m. (MonadIO m) => m (PathTo Cwd Abs Dir)+getCurrentDir = PathTo <$> P.getCurrentDir++setCurrentDir :: (MonadIO m) => PathTo e b Dir -> m ()+setCurrentDir = P.setCurrentDir . coerce++withCurrentDir :: (MonadIO m, MonadMask m) => PathTo e b Dir -> m a -> m a+withCurrentDir = P.withCurrentDir . coerce++type WithPredefined :: PredefinedDir -> k+type family WithPredefined p = w | w -> p where++data PredefinedDir+  = Home+  | AppUserData+  | UserDocs+  | TempDir+  | Cwd+  deriving (Show, Eq, Ord, Generic)++type Cwd = WithPredefined 'Cwd++type Home = WithPredefined 'Home++type AppUserData = WithPredefined 'AppUserData++type UserDocs = WithPredefined 'UserDocs++type TempDir = WithPredefined 'TempDir++getHomeDir :: (MonadIO m) => m (PathTo Home Abs Dir)+getHomeDir = PathTo <$> P.getHomeDir++getAppUserDataDir :: (MonadIO m) => String -> m (PathTo AppUserData Abs Dir)+getAppUserDataDir = fmap PathTo . P.getAppUserDataDir++getUserDocsDir :: (MonadIO m) => m (PathTo UserDocs Abs Dir)+getUserDocsDir = PathTo <$> P.getUserDocsDir++getTempDir :: (MonadIO m) => m (PathTo TempDir Abs Dir)+getTempDir = PathTo <$> P.getTempDir++type WithXdg :: forall {k}. XdgDirectory -> k+type family WithXdg xdg = p | p -> xdg where++type XdgData = WithXdg 'XdgData++type XdgConfig = WithXdg 'XdgConfig++type XdgCache = WithXdg 'XdgCache++type KnownXdgDirectory :: XdgDirectory -> Constraint+class KnownXdgDirectory xdg where+  xdgDirectory# :: Proxy# xdg -> XdgDirectory++instance KnownXdgDirectory 'XdgData where+  xdgDirectory# _ = XdgData++instance KnownXdgDirectory 'XdgConfig where+  xdgDirectory# _ = XdgConfig++instance KnownXdgDirectory 'XdgCache where+  xdgDirectory# _ = XdgCache++getXdgBaseDir ::+  forall xdg m.+  (KnownXdgDirectory xdg, MonadIO m) =>+  m (PathTo xdg Abs Dir)+getXdgBaseDir = PathTo <$> P.getXdgDir (xdgDirectory# (proxy# :: Proxy# xdg)) Nothing++getXdgDir ::+  forall xdg e m.+  (KnownXdgDirectory xdg, MonadIO m) =>+  PathTo e (RelTo (WithXdg xdg)) Dir ->+  m (PathTo e Abs Dir)+getXdgDir (PathTo p) =+  PathTo <$> P.getXdgDir (xdgDirectory# (proxy# :: Proxy# xdg)) (Just p)++getXdgDataDirs :: (MonadIO m) => m [PathTo XdgData Abs Dir]+getXdgDataDirs = coerce <$> P.getXdgDirList P.XdgDataDirs++getXdgConfigDirs :: (MonadIO m) => m [PathTo XdgConfig Abs Dir]+getXdgConfigDirs = coerce <$> P.getXdgDirList P.XdgConfigDirs++type RelPathTo :: forall {k}. k -> Type -> Type+type RelPathTo (e :: k) path = RelPathTo' k e path++class AnyPathTo path where+  type PathTag path :: Type+  type AbsPath path :: Type+  type RelPathTo' k (e :: k) path :: Type+  canonicalizePath :: (MonadIO m) => path -> m (AbsPath path)+  makeAbsolute :: (MonadIO m) => path -> m (AbsPath path)+  makeRelative :: (MonadThrow m) => PathTo (e :: PathTag path) Abs Dir -> path -> m (RelPathTo e path)+  makeRelativeToCurrentDir :: (MonadIO m) => path -> m (RelPathTo' (PathTag path) Cwd path)++instance AnyPathTo (SomeBase (e :: k) b Dir) where+  type PathTag (SomeBase (e :: k) b Dir) = k+  type AbsPath (SomeBase e b Dir) = PathTo e Abs Dir+  type RelPathTo' k e' (SomeBase e b Dir) = PathTo e (RelTo e') Dir+  canonicalizePath = \case+    IsAbs fp -> canonicalizePath fp+    IsRel fp -> canonicalizePath fp+  makeAbsolute = \case+    IsAbs fp -> makeAbsolute fp+    IsRel fp -> makeAbsolute fp+  makeRelative b = \case+    IsAbs fp -> makeRelative b fp+    IsRel fp -> makeRelative b fp+  makeRelativeToCurrentDir = \case+    IsAbs fp -> makeRelativeToCurrentDir fp+    IsRel fp -> makeRelativeToCurrentDir fp++instance AnyPathTo (SomeBase (e :: k) b File) where+  type PathTag (SomeBase (e :: k) b File) = k+  type AbsPath (SomeBase e b File) = PathTo e Abs File+  type RelPathTo' k e' (SomeBase e b File) = PathTo e (RelTo e') File+  canonicalizePath = \case+    IsAbs fp -> canonicalizePath fp+    IsRel fp -> canonicalizePath fp+  makeAbsolute = \case+    IsAbs fp -> makeAbsolute fp+    IsRel fp -> makeAbsolute fp+  makeRelative b = \case+    IsAbs fp -> makeRelative b fp+    IsRel fp -> makeRelative b fp+  makeRelativeToCurrentDir = \case+    IsAbs fp -> makeRelativeToCurrentDir fp+    IsRel fp -> makeRelativeToCurrentDir fp++instance AnyPathTo (PathTo (e :: k) b File) where+  type PathTag (PathTo (e :: k) b File) = k+  type AbsPath (PathTo e b File) = PathTo e Abs File+  type RelPathTo' k e' (PathTo e b File) = PathTo e (RelTo e') File+  canonicalizePath = fmap PathTo . P.canonicalizePath . untagPath+  makeAbsolute = fmap PathTo . P.makeAbsolute . untagPath+  makeRelative (PathTo p) = fmap PathTo . P.makeRelative p . untagPath+  makeRelativeToCurrentDir = fmap PathTo . P.makeRelativeToCurrentDir . untagPath++instance AnyPathTo (PathTo (e :: k) b Dir) where+  type PathTag (PathTo (e :: k) b Dir) = k+  type AbsPath (PathTo e b Dir) = PathTo e Abs Dir+  type RelPathTo' k e' (PathTo e b Dir) = PathTo e (RelTo e') Dir+  canonicalizePath = fmap PathTo . P.canonicalizePath . untagPath+  makeAbsolute = fmap PathTo . P.makeAbsolute . untagPath+  makeRelative (PathTo p) = fmap PathTo . P.makeRelative p . untagPath+  makeRelativeToCurrentDir = fmap PathTo . P.makeRelativeToCurrentDir . untagPath++resolveFile ::+  forall e e0 m.+  (MonadIO m) =>+  PathTo e0 Abs Dir ->+  FilePath ->+  m (PathTo e Abs File)+resolveFile = fmap (fmap PathTo) . P.resolveFile . untagPath++resolveFile' :: forall e m. (MonadIO m) => FilePath -> m (PathTo e Abs File)+resolveFile' = fmap PathTo . P.resolveFile'++resolveDir ::+  forall e e0 m.+  (MonadIO m) =>+  PathTo e0 Abs Dir ->+  FilePath ->+  m (PathTo e Abs Dir)+resolveDir = fmap (fmap PathTo) . P.resolveDir . untagPath++resolveDir' :: forall e m. (MonadIO m) => FilePath -> m (PathTo e Abs Dir)+resolveDir' = fmap PathTo . P.resolveDir'++removeFile :: (MonadIO m) => PathTo e b File -> m ()+removeFile = P.removeFile . untagPath++renameFile :: (MonadIO m) => PathTo e b0 File -> PathTo e b1 File -> m ()+renameFile (PathTo p) = P.renameFile p . untagPath++copyFile :: (MonadIO m) => PathTo e0 b0 File -> PathTo e1 b1 File -> m ()+copyFile (PathTo p) = P.copyFile p . untagPath++getFileSize :: (MonadIO m) => PathTo e b File -> m Integer+getFileSize = P.getFileSize . untagPath++findExecutable :: (MonadIO m) => PathTo e (RelTo b) File -> m (Maybe (PathTo e Abs File))+findExecutable = fmap coerce . P.findExecutable . untagPath++findFile ::+  (MonadIO m) =>+  [PathTo dir b Dir] ->+  PathTo e (RelTo dir) File ->+  m (Maybe (PathTo e Abs File))+findFile dirs = fmap coerce . P.findFile (coerce dirs) . untagPath++findFiles ::+  (MonadIO m) =>+  [PathTo dir b Dir] ->+  PathTo e (RelTo dir) File ->+  m [PathTo e Abs File]+findFiles dirs = fmap coerce . P.findFiles (coerce dirs) . untagPath++findFilesWith ::+  (MonadIO m) =>+  (PathTo e Abs File -> m Bool) ->+  [PathTo dir b Dir] ->+  PathTo e (RelTo dir) File ->+  m [PathTo e Abs File]+findFilesWith p dirs =+  fmap coerce . P.findFilesWith (p . PathTo) (coerce dirs) . untagPath++createFileLink :: (MonadIO m) => PathTo e b0 File -> PathTo e b1 File -> m ()+createFileLink (PathTo p) = P.createFileLink p . untagPath++createDirLink :: (MonadIO m) => PathTo e b0 Dir -> PathTo e b1 Dir -> m ()+createDirLink (PathTo p) = P.createDirLink p . untagPath++removeDirLink :: (MonadIO m) => PathTo e b0 Dir -> m ()+removeDirLink = P.removeDirLink . untagPath++getSymlinkTarget :: (MonadIO m) => PathTo e b t -> m FilePath+getSymlinkTarget = P.getSymlinkTarget . untagPath++isSymlink :: (MonadIO m) => PathTo e b t -> m Bool+isSymlink = P.isSymlink . untagPath++withTempFile ::+  forall e e0 b m a.+  (MonadIO m, MonadMask m) =>+  PathTo e0 b Dir ->+  String ->+  (PathTo e Abs File -> Handle -> m a) ->+  m a+withTempFile (PathTo d) name act = P.withTempFile d name $ act . PathTo++withTempDir ::+  (MonadIO m, MonadMask m) =>+  PathTo e b Dir ->+  String ->+  (PathTo TempDir Abs Dir -> m a) ->+  m a+withTempDir (PathTo d) name act = P.withTempDir d name $ act . PathTo++withSystemTempFile ::+  forall e m a.+  (MonadIO m, MonadMask m) =>+  String ->+  (PathTo e Abs File -> Handle -> m a) ->+  m a+withSystemTempFile name act = P.withSystemTempFile name $ act . PathTo++withSystemTempDir ::+  (MonadIO m, MonadMask m) =>+  String ->+  (PathTo TempDir Abs Dir -> m a) ->+  m a+withSystemTempDir name act = P.withSystemTempDir name $ act . PathTo++openTempFile ::+  forall e e0 b m.+  (MonadIO m) =>+  PathTo e0 b Dir ->+  String ->+  m (PathTo e Abs File, Handle)+openTempFile (PathTo p) = fmap coerce . P.openTempFile p++openBinaryTempFile ::+  forall e e0 b m.+  (MonadIO m) =>+  PathTo e0 b Dir ->+  String ->+  m (PathTo e Abs File, Handle)+openBinaryTempFile (PathTo p) = fmap coerce . P.openBinaryTempFile p++createTempDir :: (MonadIO m) => PathTo e b Dir -> String -> m (PathTo TempDir Abs Dir)+createTempDir (PathTo p) = fmap PathTo . P.createTempDir p++doesPathExist :: (MonadIO m) => PathTo e b t -> m Bool+doesPathExist = P.doesPathExist . untagPath++doesFileExist :: (MonadIO m) => PathTo e b File -> m Bool+doesFileExist = P.doesFileExist . untagPath++doesDirExist :: (MonadIO m) => PathTo e b Dir -> m Bool+doesDirExist = P.doesDirExist . untagPath++isLocationOccupied :: (MonadIO m) => PathTo e b t -> m Bool+isLocationOccupied = P.isLocationOccupied . untagPath++getPermissions :: (MonadIO m) => PathTo e b t -> m Permissions+getPermissions = P.getPermissions . untagPath++setPermissions :: (MonadIO m) => PathTo e b t -> Permissions -> m ()+setPermissions = P.setPermissions . untagPath++copyPermissions :: (MonadIO m) => PathTo e0 b0 t0 -> PathTo e1 b1 t1 -> m ()+copyPermissions (PathTo p) = P.copyPermissions p . untagPath++getAccessTime :: (MonadIO m) => PathTo entity pk t -> m UTCTime+getAccessTime = P.getAccessTime . untagPath++setAccessTime :: (MonadIO m) => PathTo entity pk t -> UTCTime -> m ()+setAccessTime = P.setAccessTime . untagPath++getModificationTime :: (MonadIO m) => PathTo entity pk t -> m UTCTime+getModificationTime = P.getModificationTime . untagPath++setModificationTime :: (MonadIO m) => PathTo entity pk t -> UTCTime -> m ()+setModificationTime = P.setModificationTime . untagPath
+ test/Test.hs view
@@ -0,0 +1,3 @@+module Main (main) where++import Cases
+ test/cases/Cases.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display -optF --generated-module=Cases #-}