liblawless-0.17.2: 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.toString,
    P.rootDir,
    P.currentDir,
    P.emptyFile,
    parse,
    toText,
    AbsFile,
    RelFile,
    AbsDir,
    RelDir,
    AbsRelFile,
    AbsRelDir,
    absFile,
    relFile,
    absDir,
    relDir,
    absRelFile,
    absRelDir,
    (</>),
    (<.>)
    ) where

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

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