-------------------------------------------------------------------
--
-- Module      :  Filenames
-- Copyright   :  andrew u frank -
--
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

-- | the operations on filenames and extensions
--  uses the Path library, but wraps it in Path (to construct a read)
-- is a class except for the make
module Uniform.Filenames
  ( module Uniform.Filenames,
    module Uniform.Error,
    -- module Path.Internal,
    -- module Uniform.PathShowCase,
    Abs,
    Rel,
    File,
    Dir,
    Path,
    -- Path.Path(..),
    toFilePath,
  )
where

-- for Generics
-- import Path 
--   ( Abs,
--     Dir,
--     File,
--     Path,
--     Rel,
--     toFilePath,
--     Path
--   )
import Path hiding ((</>), addExtension)
import qualified Path 
-- import  Path.Internal (Path(..))
import qualified Path.IO as PathIO
import qualified System.FilePath as S
import Uniform.Error(ErrIO, callIO)
-- import Uniform.Zero(Zeros(..))
import Uniform.Strings
-- (Text, fromJustNote, t2s)
import Uniform.PathShowCase ()

takeBaseName' :: FilePath -> FilePath
takeBaseName' :: FilePath -> FilePath
takeBaseName' = FilePath -> FilePath
S.takeBaseName

homeDir :: Path Abs Dir
homeDir :: Path Abs Dir
homeDir = FilePath -> Path Abs Dir
makeAbsDir FilePath
"/home/frank/" :: Path Abs Dir

homeDir2 :: ErrIO (Path Abs Dir)
homeDir2 :: ErrIO (Path Abs Dir)
homeDir2 = IO (Path Abs Dir) -> ErrIO (Path Abs Dir)
forall (m :: * -> *) a.
(MonadError m, MonadIO m, ErrorType m ~ Text) =>
IO a -> m a
callIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
PathIO.getHomeDir :: ErrIO (Path Abs Dir)

-- replace homeDir with homeDir2 - is user independent but requires IO
currentDir :: ErrIO (Path Abs Dir)
currentDir :: ErrIO (Path Abs Dir)
currentDir = IO (Path Abs Dir) -> ErrIO (Path Abs Dir)
forall (m :: * -> *) a.
(MonadError m, MonadIO m, ErrorType m ~ Text) =>
IO a -> m a
callIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
PathIO.getCurrentDir

setCurrentDir :: Path Abs Dir -> ErrIO ()
setCurrentDir :: Path Abs Dir -> ErrIO ()
setCurrentDir Path Abs Dir
path = Path Abs Dir -> ErrIO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
PathIO.setCurrentDir (Path Abs Dir -> Path Abs Dir
forall a. a -> a
unPath Path Abs Dir
path)

stripProperPrefix' :: Path b Dir -> Path b t -> ErrIO (Path Rel t)
stripProperPrefix' :: Path b Dir -> Path b t -> ErrIO (Path Rel t)
stripProperPrefix' Path b Dir
dir Path b t
fn = Path b Dir -> Path b t -> ErrIO (Path Rel t)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
Path.stripProperPrefix (Path b Dir -> Path b Dir
forall a. a -> a
unPath Path b Dir
dir) (Path b t -> Path b t
forall a. a -> a
unPath Path b t
fn)

stripProperPrefixMaybe :: Path b Dir -> Path b t -> Maybe (Path Rel t)
stripProperPrefixMaybe :: Path b Dir -> Path b t -> Maybe (Path Rel t)
stripProperPrefixMaybe Path b Dir
dir Path b t
fn = Path b Dir -> Path b t -> Maybe (Path Rel t)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
Path.stripProperPrefix (Path b Dir -> Path b Dir
forall a. a -> a
unPath Path b Dir
dir) (Path b t -> Path b t
forall a. a -> a
unPath Path b t
fn)

unPath :: a -> a
unPath :: a -> a
unPath = a -> a
forall a. a -> a
id

    

makeRelFile :: FilePath -> Path Rel File
makeRelDir :: FilePath -> Path Rel Dir
makeAbsFile :: FilePath -> Path Abs File
makeAbsDir :: FilePath -> Path Abs Dir
makeRelFile :: FilePath -> Path Rel File
makeRelFile FilePath
fn = FilePath -> Maybe (Path Rel File) -> Path Rel File
forall a. Partial => FilePath -> Maybe a -> a
fromJustNote (FilePath
"makeRelFile " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn) (Maybe (Path Rel File) -> Path Rel File)
-> Maybe (Path Rel File) -> Path Rel File
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
Path.parseRelFile FilePath
fn

makeRelDir :: FilePath -> Path Rel Dir
makeRelDir FilePath
fn = FilePath -> Maybe (Path Rel Dir) -> Path Rel Dir
forall a. Partial => FilePath -> Maybe a -> a
fromJustNote (FilePath
"makeRelDir " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn) (Maybe (Path Rel Dir) -> Path Rel Dir)
-> Maybe (Path Rel Dir) -> Path Rel Dir
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
Path.parseRelDir FilePath
fn

makeAbsFile :: FilePath -> Path Abs File
makeAbsFile FilePath
fn = FilePath -> Maybe (Path Abs File) -> Path Abs File
forall a. Partial => FilePath -> Maybe a -> a
fromJustNote (FilePath
"makeAbsFile " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn) (Maybe (Path Abs File) -> Path Abs File)
-> Maybe (Path Abs File) -> Path Abs File
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
Path.parseAbsFile FilePath
fn

makeAbsDir :: FilePath -> Path Abs Dir
makeAbsDir FilePath
fn = FilePath -> Maybe (Path Abs Dir) -> Path Abs Dir
forall a. Partial => FilePath -> Maybe a -> a
fromJustNote (FilePath
"makeAbsDir " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn) (Maybe (Path Abs Dir) -> Path Abs Dir)
-> Maybe (Path Abs Dir) -> Path Abs Dir
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
Path.parseAbsDir FilePath
fn

makeRelFileT :: Text -> Path Rel File
makeRelDirT :: Text -> Path Rel Dir
makeAbsFileT :: Text -> Path Abs File
makeAbsDirT :: Text -> Path Abs Dir
makeRelFileT :: Text -> Path Rel File
makeRelFileT = FilePath -> Path Rel File
makeRelFile (FilePath -> Path Rel File)
-> (Text -> FilePath) -> Text -> Path Rel File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s

makeRelDirT :: Text -> Path Rel Dir
makeRelDirT = FilePath -> Path Rel Dir
makeRelDir (FilePath -> Path Rel Dir)
-> (Text -> FilePath) -> Text -> Path Rel Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s

makeAbsFileT :: Text -> Path Abs File
makeAbsFileT = FilePath -> Path Abs File
makeAbsFile (FilePath -> Path Abs File)
-> (Text -> FilePath) -> Text -> Path Abs File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s

makeAbsDirT :: Text -> Path Abs Dir
makeAbsDirT = FilePath -> Path Abs Dir
makeAbsDir (FilePath -> Path Abs Dir)
-> (Text -> FilePath) -> Text -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s

toShortFilePath :: Path df ar -> FilePath
---- ^ get the filepath, but without the trailing separator
--    , necessary for systemcalls
toShortFilePath :: Path df ar -> FilePath
toShortFilePath = FilePath -> FilePath
S.dropTrailingPathSeparator (FilePath -> FilePath)
-> (Path df ar -> FilePath) -> Path df ar -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path df ar -> FilePath
forall b t. Path b t -> FilePath
toFilePath

instance Zeros (Path Abs Dir) where
  zero :: Path Abs Dir
zero = FilePath -> Path Abs Dir
makeAbsDir FilePath
"/"

instance Zeros (Path Abs File) where
  zero :: Path Abs File
zero = FilePath -> Path Abs File
makeAbsFile FilePath
"/zero"

instance Zeros (Path Rel Dir) where
  zero :: Path Rel Dir
zero = FilePath -> Path Rel Dir
makeRelDir FilePath
"./"

instance Zeros (Path Rel File) where
  zero :: Path Rel File
zero = FilePath -> Path Rel File
makeRelFile FilePath
"zero"

newtype Extension = Extension FilePath deriving (Int -> Extension -> FilePath -> FilePath
[Extension] -> FilePath -> FilePath
Extension -> FilePath
(Int -> Extension -> FilePath -> FilePath)
-> (Extension -> FilePath)
-> ([Extension] -> FilePath -> FilePath)
-> Show Extension
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Extension] -> FilePath -> FilePath
$cshowList :: [Extension] -> FilePath -> FilePath
show :: Extension -> FilePath
$cshow :: Extension -> FilePath
showsPrec :: Int -> Extension -> FilePath -> FilePath
$cshowsPrec :: Int -> Extension -> FilePath -> FilePath
Show, ReadPrec [Extension]
ReadPrec Extension
Int -> ReadS Extension
ReadS [Extension]
(Int -> ReadS Extension)
-> ReadS [Extension]
-> ReadPrec Extension
-> ReadPrec [Extension]
-> Read Extension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Extension]
$creadListPrec :: ReadPrec [Extension]
readPrec :: ReadPrec Extension
$creadPrec :: ReadPrec Extension
readList :: ReadS [Extension]
$creadList :: ReadS [Extension]
readsPrec :: Int -> ReadS Extension
$creadsPrec :: Int -> ReadS Extension
Read, Extension -> Extension -> Bool
(Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool) -> Eq Extension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extension -> Extension -> Bool
$c/= :: Extension -> Extension -> Bool
== :: Extension -> Extension -> Bool
$c== :: Extension -> Extension -> Bool
Eq, Eq Extension
Eq Extension
-> (Extension -> Extension -> Ordering)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Extension)
-> (Extension -> Extension -> Extension)
-> Ord Extension
Extension -> Extension -> Bool
Extension -> Extension -> Ordering
Extension -> Extension -> Extension
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 :: Extension -> Extension -> Extension
$cmin :: Extension -> Extension -> Extension
max :: Extension -> Extension -> Extension
$cmax :: Extension -> Extension -> Extension
>= :: Extension -> Extension -> Bool
$c>= :: Extension -> Extension -> Bool
> :: Extension -> Extension -> Bool
$c> :: Extension -> Extension -> Bool
<= :: Extension -> Extension -> Bool
$c<= :: Extension -> Extension -> Bool
< :: Extension -> Extension -> Bool
$c< :: Extension -> Extension -> Bool
compare :: Extension -> Extension -> Ordering
$ccompare :: Extension -> Extension -> Ordering
$cp1Ord :: Eq Extension
Ord)

unExtension :: Extension -> FilePath
unExtension :: Extension -> FilePath
unExtension (Extension FilePath
e) = FilePath
e

makeExtension :: FilePath -> Extension
makeExtension :: FilePath -> Extension
makeExtension = FilePath -> Extension
Extension

-- extension does not include a leading "."
-- would need a makeExtension in IO to catch errors here
makeExtensionT :: Text -> Extension
makeExtensionT :: Text -> Extension
makeExtensionT = FilePath -> Extension
Extension (FilePath -> Extension) -> (Text -> FilePath) -> Text -> Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s

class Filenames fp fr where
  getFileName :: fp -> fr

class Filenames3 fp file where
  type FileResultT fp file

  -- add a filepath to a absolute dir and givev an absolte file
  --
  (</>), addFileName :: fp -> file -> FileResultT fp file
  -- fails, if file is empty  does not add anything if file is empty
  (</>) = fp -> file -> FileResultT fp file
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
addFileName

class Filenames5 dir fil res where
  stripPrefix :: dir -> fil -> Maybe res
  -- ^ strip the

instance Filenames5 (Path b Dir) (Path b t) (Path Rel t) where
  stripPrefix :: Path b Dir -> Path b t -> Maybe (Path Rel t)
stripPrefix Path b Dir
d Path b t
f = Path b Dir -> Path b t -> Maybe (Path Rel t)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
Path.stripProperPrefix (Path b Dir -> Path b Dir
forall a. a -> a
unPath Path b Dir
d) (Path b t -> Path b t
forall a. a -> a
unPath Path b t
f)

class Filenames4 fp file where
  type FileResultT4 fp file

  -- add a filepath to a absolute dir and givev an absolte dir
  --
  addDir :: fp -> file -> FileResultT4 fp file

class Filenames1 fp where
  -- instantiate only for filepath TODO do for path
  getImmediateParentDir :: fp -> FilePath
  -- ^ gets the name of the dir immediately above

  getParentDir :: fp -> FilePath
  -- ^ the parent dir of file

  getNakedFileName :: fp -> FilePath
  -- ^ filename without extension

  getNakedDir :: fp -> FilePath
  -- ^ get the last dir

instance Filenames FilePath FilePath where
  getFileName :: FilePath -> FilePath
getFileName = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
S.splitFileName

instance Filenames3 FilePath FilePath where
  type FileResultT FilePath FilePath = FilePath
  addFileName :: FilePath -> FilePath -> FileResultT FilePath FilePath
addFileName = FilePath -> FilePath -> FilePath
FilePath -> FilePath -> FileResultT FilePath FilePath
S.combine

instance Filenames (Path ar File) (Path Rel File) where
  getFileName :: Path ar File -> Path Rel File
getFileName = Path ar File -> Path Rel File
forall ar. Path ar File -> Path Rel File
Path.filename (Path ar File -> Path Rel File)
-> (Path ar File -> Path ar File) -> Path ar File -> Path Rel File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar File -> Path ar File
forall a. a -> a
unPath

instance Filenames3 (Path b Dir) FilePath where
  type FileResultT (Path b Dir) FilePath = (Path b File)
  addFileName :: Path b Dir -> FilePath -> FileResultT (Path b Dir) FilePath
addFileName Path b Dir
p FilePath
d =
    if FilePath -> Bool
forall a. CharChains a => a -> Bool
null' FilePath
d
      then FilePath -> Path b File
forall a. Partial => FilePath -> a
error (FilePath
"addFileName with empty file" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d)
      else Path b Dir -> Path Rel File -> Path b File
forall b t. Path b Dir -> Path Rel t -> Path b t
(Path.</>) (Path b Dir -> Path b Dir
forall a. a -> a
unPath Path b Dir
p) (Path Rel File -> Path Rel File
forall a. a -> a
unPath Path Rel File
d2)
    where
      d2 :: Path Rel File
d2 = FilePath -> Path Rel File
makeRelFile FilePath
d :: Path Rel File

instance Filenames4 FilePath FilePath where
  type FileResultT4 FilePath FilePath = FilePath
  addDir :: FilePath -> FilePath -> FileResultT4 FilePath FilePath
addDir FilePath
p FilePath
d = if FilePath -> Bool
forall a. CharChains a => a -> Bool
null' FilePath
d then FilePath
FileResultT4 FilePath FilePath
p else FilePath
p FilePath -> FilePath -> FileResultT FilePath FilePath
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> FilePath
d

instance Filenames4 (Path b Dir) FilePath where
  type FileResultT4 (Path b Dir) FilePath = (Path b Dir)
  addDir :: Path b Dir -> FilePath -> FileResultT4 (Path b Dir) FilePath
addDir Path b Dir
p FilePath
d =
    if FilePath -> Bool
forall a. CharChains a => a -> Bool
null' FilePath
d
      then Path b Dir
FileResultT4 (Path b Dir) FilePath
p
      else Path b Dir
p Path b Dir
-> Path Rel Dir -> FileResultT (Path b Dir) (Path Rel Dir)
forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel Dir
d2
    where
      d2 :: Path Rel Dir
d2 = FilePath -> Path Rel Dir
makeRelDir FilePath
d :: Path Rel Dir

instance Filenames4 (Path b Dir) (Path Rel t) where
  type FileResultT4 (Path b Dir) (Path Rel t) = (Path b t)
  addDir :: Path b Dir -> Path Rel t -> FileResultT4 (Path b Dir) (Path Rel t)
addDir Path b Dir
p Path Rel t
d = Path b Dir -> Path Rel t -> Path b t
forall b t. Path b Dir -> Path Rel t -> Path b t
(Path.</>) (Path b Dir -> Path b Dir
forall a. a -> a
unPath Path b Dir
p) (Path Rel t -> Path Rel t
forall a. a -> a
unPath Path Rel t
d)

instance Filenames3 (Path b Dir) (Path Rel t) where
  type FileResultT (Path b Dir) (Path Rel t) = (Path b t)
  addFileName :: Path b Dir -> Path Rel t -> FileResultT (Path b Dir) (Path Rel t)
addFileName Path b Dir
p Path Rel t
d = Path b Dir -> Path Rel t -> Path b t
forall b t. Path b Dir -> Path Rel t -> Path b t
(Path.</>) (Path b Dir -> Path b Dir
forall a. a -> a
unPath Path b Dir
p) (Path Rel t -> Path Rel t
forall a. a -> a
unPath Path Rel t
d)

instance Filenames1 (Path ar File) where
  getNakedFileName :: Path ar File -> FilePath
getNakedFileName = FilePath -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getNakedFileName (FilePath -> FilePath)
-> (Path ar File -> FilePath) -> Path ar File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar File -> FilePath
forall b t. Path b t -> FilePath
toFilePath
  getImmediateParentDir :: Path ar File -> FilePath
getImmediateParentDir = FilePath -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getImmediateParentDir (FilePath -> FilePath)
-> (Path ar File -> FilePath) -> Path ar File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar File -> FilePath
forall b t. Path b t -> FilePath
toFilePath
  getParentDir :: Path ar File -> FilePath
getParentDir = FilePath -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getParentDir (FilePath -> FilePath)
-> (Path ar File -> FilePath) -> Path ar File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar File -> FilePath
forall b t. Path b t -> FilePath
toFilePath
  getNakedDir :: Path ar File -> FilePath
getNakedDir = FilePath -> Path ar File -> FilePath
forall a. Partial => FilePath -> a
error FilePath
"getNakedDir for Filenamse1 Path ar File) not existing"

instance Filenames1 (Path ar Dir) where
  getNakedFileName :: Path ar Dir -> FilePath
getNakedFileName = FilePath -> Path ar Dir -> FilePath
forall a. Partial => FilePath -> a
error FilePath
"getNakedFileName not from Dir"
  getImmediateParentDir :: Path ar Dir -> FilePath
getImmediateParentDir = FilePath -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getImmediateParentDir (FilePath -> FilePath)
-> (Path ar Dir -> FilePath) -> Path ar Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath
  getParentDir :: Path ar Dir -> FilePath
getParentDir = FilePath -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getParentDir (FilePath -> FilePath)
-> (Path ar Dir -> FilePath) -> Path ar Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath
  getNakedDir :: Path ar Dir -> FilePath
getNakedDir = FilePath -> FilePath
forall fp. Filenames1 fp => fp -> FilePath
getNakedDir (FilePath -> FilePath)
-> (Path ar Dir -> FilePath) -> Path ar Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath

instance Filenames1 FilePath where
  getNakedFileName :: FilePath -> FilePath
getNakedFileName = FilePath -> FilePath
forall fp. Extensions fp => fp -> fp
removeExtension (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall fp fr. Filenames fp fr => fp -> fr
getFileName
  getImmediateParentDir :: FilePath -> FilePath
getImmediateParentDir = ([FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int
1) ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
S.splitDirectories
  getParentDir :: FilePath -> FilePath
getParentDir = FilePath -> FilePath
S.takeDirectory
  getNakedDir :: FilePath -> FilePath
getNakedDir = ([FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int
0) ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
S.splitDirectories

class (Eq (ExtensionType fp)) => Extensions fp where
  -- extension do not include a leading '.'
  type ExtensionType fp
  getExtension :: fp -> ExtensionType fp
  removeExtension :: fp -> fp
  addExtension :: ExtensionType fp -> fp -> fp
  setFileExtension :: ExtensionType fp -> fp -> fp 

  -- must not have an extension before
  (<.>) :: fp -> ExtensionType fp -> fp -- eror when not legal?
  (<.>) fp
f ExtensionType fp
e = ExtensionType fp -> fp -> fp
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
addExtension ExtensionType fp
e fp
f
  setExtension :: ExtensionType fp -> fp -> fp
  hasExtension :: ExtensionType fp -> fp -> Bool
  hasExtension ExtensionType fp
e = (ExtensionType fp
e ExtensionType fp -> ExtensionType fp -> Bool
forall a. Eq a => a -> a -> Bool
==) (ExtensionType fp -> Bool)
-> (fp -> ExtensionType fp) -> fp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fp -> ExtensionType fp
forall fp. Extensions fp => fp -> ExtensionType fp
getExtension

  prop_add_has :: ExtensionType fp -> fp -> Bool
  prop_add_has ExtensionType fp
e fp
f = ExtensionType fp -> fp -> Bool
forall fp. Extensions fp => ExtensionType fp -> fp -> Bool
hasExtension ExtensionType fp
e (ExtensionType fp -> fp -> fp
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
addExtension ExtensionType fp
e fp
f)
  prop_add_add_has :: ExtensionType fp -> ExtensionType fp -> fp -> Bool
  prop_add_add_has ExtensionType fp
e1 ExtensionType fp
e2 fp
f =
    ExtensionType fp -> fp -> Bool
forall fp. Extensions fp => ExtensionType fp -> fp -> Bool
hasExtension
      ExtensionType fp
e1
      (ExtensionType fp -> fp -> fp
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension ExtensionType fp
e1 (fp -> fp) -> (fp -> fp) -> fp -> fp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtensionType fp -> fp -> fp
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension ExtensionType fp
e2 (fp -> fp) -> fp -> fp
forall a b. (a -> b) -> a -> b
$ fp
f)
  prop_set_get :: ExtensionType fp -> fp -> Bool
  prop_set_get ExtensionType fp
e fp
f = ((ExtensionType fp
e ExtensionType fp -> ExtensionType fp -> Bool
forall a. Eq a => a -> a -> Bool
==) (ExtensionType fp -> Bool)
-> (fp -> ExtensionType fp) -> fp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fp -> ExtensionType fp
forall fp. Extensions fp => fp -> ExtensionType fp
getExtension) (ExtensionType fp -> fp -> fp
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension ExtensionType fp
e fp
f)

instance Extensions FilePath where
  type ExtensionType FilePath = FilePath

  getExtension :: FilePath -> ExtensionType FilePath
getExtension = Char -> FilePath -> FilePath
forall a. CharChains a => Char -> a -> a
removeChar Char
'.' (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
S.splitExtension
  addExtension :: ExtensionType FilePath -> FilePath -> FilePath
addExtension ExtensionType FilePath
e FilePath
fp = FilePath
fp FilePath -> FilePath -> FilePath
S.<.> FilePath
ExtensionType FilePath
e
  removeExtension :: FilePath -> FilePath
removeExtension = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
S.splitExtension
  setFileExtension :: ExtensionType FilePath -> FilePath -> FilePath
setFileExtension ExtensionType FilePath
e = ExtensionType FilePath -> FilePath -> FilePath
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
addExtension ExtensionType FilePath
e (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall fp. Extensions fp => fp -> fp
removeExtension

--    hasExtension e = (e ==) . getExtension

instance Extensions (Path ar File) where
  type ExtensionType (Path ar File) = Extension

  getExtension :: Path ar File -> ExtensionType (Path ar File)
getExtension Path ar File
f = FilePath -> Extension
Extension FilePath
e
    where
      -- definition of extension in path is with leading '.'
      -- multiple extensions are gradually built and removed
      -- split gives only the last
      -- add allows only one to add
      -- empty extensions throw error

      e :: FilePath
e = FilePath -> FilePath
forall fp. Extensions fp => fp -> ExtensionType fp
getExtension (FilePath -> FilePath)
-> (Path ar File -> FilePath) -> Path ar File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ar File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path ar File -> FilePath) -> Path ar File -> FilePath
forall a b. (a -> b) -> a -> b
$ Path ar File
f

  setExtension :: ExtensionType (Path ar File) -> Path ar File -> Path ar File
setExtension ExtensionType (Path ar File)
e Path ar File
f =
    FilePath -> Maybe (Path ar File) -> Path ar File
forall a. Partial => FilePath -> Maybe a -> a
fromJustNote FilePath
"setExtension" (Maybe (Path ar File) -> Path ar File)
-> Maybe (Path ar File) -> Path ar File
forall a b. (a -> b) -> a -> b
$ FilePath -> Path ar File -> Maybe (Path ar File)
forall (m :: * -> *) b.
MonadThrow m =>
FilePath -> Path b File -> m (Path b File)
Path.setFileExtension (Extension -> FilePath
unExtension ExtensionType (Path ar File)
Extension
e) Path ar File
f

  addExtension :: ExtensionType (Path ar File) -> Path ar File -> Path ar File
addExtension = ExtensionType (Path ar File) -> Path ar File -> Path ar File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension
  removeExtension :: Path ar File -> Path ar File
removeExtension = ExtensionType (Path ar File) -> Path ar File -> Path ar File
forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (FilePath -> Extension
Extension FilePath
"")