module Path where

import           System.FilePath
import           Data.String

fromFilePath :: FilePath -> Path
fromFilePath :: FilePath -> Path
fromFilePath = [PathComponent] -> Path
Path ([PathComponent] -> Path)
-> (FilePath -> [PathComponent]) -> FilePath -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> PathComponent) -> [FilePath] -> [PathComponent]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> PathComponent
PathComponent ([FilePath] -> [PathComponent])
-> (FilePath -> [FilePath]) -> FilePath -> [PathComponent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories

toFilePath :: Path -> FilePath
toFilePath :: Path -> FilePath
toFilePath = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> (Path -> [FilePath]) -> Path -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> [FilePath]
components

components :: Path -> [String]
components :: Path -> [FilePath]
components = (PathComponent -> FilePath) -> [PathComponent] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PathComponent -> FilePath
unPathComponent ([PathComponent] -> [FilePath])
-> (Path -> [PathComponent]) -> Path -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> [PathComponent]
unPath

newtype Path = Path {Path -> [PathComponent]
unPath :: [PathComponent]}
  deriving Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq

instance Show Path where
  show :: Path -> FilePath
show = ShowS
forall a. Show a => a -> FilePath
show ShowS -> (Path -> FilePath) -> Path -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> FilePath
toFilePath

instance IsString Path where
  fromString :: FilePath -> Path
fromString = FilePath -> Path
fromFilePath

newtype PathComponent = PathComponent {PathComponent -> FilePath
unPathComponent :: String}
  deriving PathComponent -> PathComponent -> Bool
(PathComponent -> PathComponent -> Bool)
-> (PathComponent -> PathComponent -> Bool) -> Eq PathComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathComponent -> PathComponent -> Bool
$c/= :: PathComponent -> PathComponent -> Bool
== :: PathComponent -> PathComponent -> Bool
$c== :: PathComponent -> PathComponent -> Bool
Eq