{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{- |
   Module      : Path.Like
   License     : MIT
   Stability   : experimental

Type classes for compiling down to well-typed `Path`s.
-}

module Path.Like (
  PathLike(..)
, FileLike(..)
, DirLike(..)
, (/>)
) where

import Path

-- | Class representing a type `a` that can be compiled down to a `Path b t`.
class PathLike b t a | a -> b, a -> t where
  toPath :: a -> Path b t

-- | Class representing a type `a` that can be compiled down to a `Path b File`.
class PathLike b File a => FileLike b a where
  toFile :: a -> Path b File
  toFile = a -> Path b File
forall b t a. PathLike b t a => a -> Path b t
toPath

-- | Class repreenting a type `a` that can be compiled down to a `Path b Dir`.
class PathLike b Dir a => DirLike b a where
  toDir :: a -> Path b Dir
  toDir = a -> Path b Dir
forall b t a. PathLike b t a => a -> Path b t
toPath

instance PathLike b t (Path b t) where
  toPath :: Path b t -> Path b t
toPath = Path b t -> Path b t
forall a. a -> a
id

instance FileLike b (Path b File)
instance DirLike b (Path b Dir)

-- | Like `Path.</>`, but works for any `DirLike` and relative `FileLike` to produce a concrete `Path`.
(/>) :: (DirLike b a, FileLike Rel c) => a -> c -> Path b File
/> :: a -> c -> Path b File
(/>) a
x c
y = a -> Path b Dir
forall b a. DirLike b a => a -> Path b Dir
toDir a
x Path b Dir -> Path Rel File -> Path b File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> c -> Path Rel File
forall b a. FileLike b a => a -> Path b File
toFile c
y