liblawless-0.19.0: Source/Path.hs

{-# OPTIONS_GHC -Wno-orphans #-}

{-|
Module:             Path
Description:        Provides pathtype exports for paths and I/O.
Copyright:          © 2016 All rights reserved.
License:            GPL-3
Maintainer:         Evan Cofsky <>
Stability:          experimental
Portability:        POSIX
-}

module Path (
    P.addExtension,
    P.combine,
    P.currentDir,
    P.dropExtension,
    P.dropExtensions,
    P.dropFileName,
    P.emptyFile,
    P.mapFileName,
    P.mapFileNameF,
    P.replaceBaseName,
    P.replaceDirectory,
    P.replaceExtension,
    P.replaceFileName,
    P.rootDir,
    P.splitDirName,
    P.splitExtension,
    P.splitExtensions,
    P.splitFileName,
    P.splitPath,
    P.takeBaseName,
    P.takeDirName,
    P.takeDirectory,
    P.takeExtension,
    P.takeExtensions,
    P.takeFileName,
    P.takeSuperDirectory,
    P.toString,

    -- * Auxillary Manipulation Functions
    P.dirFromFile,
    P.dirFromFileDir,
    P.dynamicMakeAbsolute,
    P.dynamicMakeAbsoluteFromCwd,
    P.equalFilePath,
    P.fileFromDir,
    P.fileFromFileDir,
    P.fromFileDir,
    P.genericMakeAbsolute,
    P.genericMakeAbsoluteFromCwd,
    P.joinPath,
    P.makeAbsolute,
    P.makeAbsoluteFromCwd,
    P.makeRelative,
    P.makeRelativeMaybe,
    P.normalise,
    P.pathMap,
    P.toFileDir,

    -- * Path Predicates
    P.isAbsolute,
    P.isRelative,
    P.isAbsoluteString,
    P.isRelativeString,
    P.hasAnExtension,
    P.hasExtension,

    -- * Separators
    P.extSeparator,
    P.searchPathSeparator,
    P.isExtSeparator,
    P.isSearchPathSeparator,

    -- * Generic Manipulation Functions
    P.genericAddExtension,
    P.genericDropExtension,
    P.genericDropExtensions,
    P.genericSplitExtension,
    P.genericSplitExtensions,
    P.genericTakeExtension,
    P.genericTakeExtensions,
    P.parse,
    toText,
    AbsFile,
    RelFile,
    AbsDir,
    RelDir,
    AbsRelFile,
    AbsRelDir,
    File,
    absFile,
    relFile,
    absDir,
    relDir,
    absRelFile,
    absRelDir,
    (</>),
    (<.>),
    (<++>),
    ) where

import Lawless hiding ((<.>))
import Text
import System.Path (
    AbsFile,
    RelFile,
    AbsDir,
    RelDir,
    AbsRelFile,
    AbsRelDir,
    File,
    (</>),
    (<.>),
    (<++>)
    )
import qualified System.Path as P
import qualified System.Path.PartClass as C
import Aeson hiding (parse)
import Control.Monad.Fail

parse ∷ (IsText t, C.AbsRel ar, C.FileDir fd) ⇒ t → Either Text (P.Path ar fd)
parse t = case P.parse (t ^. unpacked) of
    Left s → Left $ s ^. packed
    Right p → Right p

toText ∷ (C.AbsRel ar, C.FileDir fd) ⇒ P.Path ar fd → Text
toText = view packed ∘ P.toString

fromText ∷ (IsText t) ⇒ t → [Char]
fromText = view unpacked

relFile ∷ (IsText t) ⇒ t → P.RelFile
relFile = P.relFile ∘ fromText

relDir ∷ (IsText t) ⇒ t → P.RelDir
relDir = P.relDir ∘ fromText

absFile ∷ (IsText t) ⇒ t → P.AbsFile
absFile = P.absFile ∘ fromText

absDir ∷ (IsText t) ⇒ t → P.AbsDir
absDir = P.absDir ∘ fromText

absRelFile ∷ (IsText t) ⇒ t → P.AbsRelFile
absRelFile = P.absRel ∘ fromText

absRelDir ∷ (IsText t) ⇒ t → P.AbsRelDir
absRelDir = P.absRel ∘ fromText

instance FromJSON AbsFile where
    parseJSON (String p) = case Path.parse (p ^. unpacked) of
        Left e → fail ∘ fromText $ e
        Right v → return v
    parseJSON v = typeMismatch "AbsFile" v

instance ToJSON AbsFile where
    toJSON = String ∘ toText

instance FromJSON AbsDir where
    parseJSON (String p) = case Path.parse (p ^. unpacked) of
        Left e → fail ∘ fromText $ e
        Right v → return v
    parseJSON v = typeMismatch "AbsDir" v

instance ToJSON AbsDir where
    toJSON = String ∘ toText

instance ToJSON RelFile where
    toJSON = String ∘ toText

instance FromJSON RelDir where
    parseJSON (String p) = case Path.parse (p ^. unpacked) of
        Left e → fail ∘ fromText $ e
        Right v → return v
    parseJSON v = typeMismatch "RelDir" v

instance ToJSON RelDir where
    toJSON = String ∘ toText

instance FromJSON AbsRelDir where
    parseJSON (String p) = case Path.parse (p ^. unpacked) of
        Left e → fail ∘ fromText $ e
        Right v → return v
    parseJSON v = typeMismatch "AbsRelDir" v

instance ToJSON AbsRelDir where
    toJSON = String ∘ toText

instance FromJSON AbsRelFile where
    parseJSON (String p) = case Path.parse (p ^. unpacked) of
        Left e → fail ∘ fromText $ e
        Right v → return v
    parseJSON v = typeMismatch "AbsRelFile" v

instance ToJSON AbsRelFile where
    toJSON = String ∘ toText