ToFilePath.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}

module System.FilePath.FilePather.ToFilePath(
  ToFilePathT(..)
, ToFilePath
, toFilePath
, toRead
) where

import Control.Applicative ( Applicative(pure, liftA2) )
import Control.Category ( Category((.)) )
import Control.Lens ( iso, Iso, Wrapped(..) )
import Data.Functor.Contravariant ( Contravariant(contramap) )
import Data.Either ( either )
import Data.Functor.Contravariant.Divisible
    ( Decidable(..), Divisible(..) )
import Data.Functor.Identity ( Identity(..) )
import Data.Void ( absurd )
import System.FilePath ( (</>), FilePath )
import System.FilePath.FilePather.ReadFilePath
    ( ReadFilePathT(..) )

newtype ToFilePathT f a =
  ToFilePathT (a -> f FilePath)

type ToFilePath a =
  ToFilePathT Identity a

instance Wrapped (ToFilePathT f a) where
  type Unwrapped (ToFilePathT f a) =
    a
    -> f FilePath
  _Wrapped' =
    iso (\(ToFilePathT x) -> x) ToFilePathT
  {-# INLINE _Wrapped' #-}

instance Contravariant (ToFilePathT f) where
  contramap f (ToFilePathT g) =
    ToFilePathT (g . f)

instance Applicative f => Divisible (ToFilePathT f) where
  divide f (ToFilePathT g) (ToFilePathT h) =
    ToFilePathT (\x -> let (b, c) = f x in liftA2 (</>) (g b) (h c))
  conquer =
    ToFilePathT (pure (pure ""))

instance Applicative f => Decidable (ToFilePathT f) where
  choose f (ToFilePathT g) (ToFilePathT h) =
    ToFilePathT (either g h . f)
  lose f =
    ToFilePathT (absurd . f)

toFilePath ::
  Iso
    (ToFilePath a)
    (ToFilePath a')
    (a -> FilePath)
    (a' -> FilePath)
toFilePath =
  iso
    (\(ToFilePathT x) -> runIdentity . x)
    (\p -> ToFilePathT (Identity . p))
{-# INLINE toFilePath #-}

toRead ::
  Iso
    (ToFilePathT f FilePath)
    (ToFilePathT f' FilePath)
    (ReadFilePathT f FilePath)
    (ReadFilePathT f' FilePath)
toRead =
  iso
    (\(ToFilePathT x) -> ReadFilePathT x)
    (\(ReadFilePathT x) -> ToFilePathT x)
{-# INLINE toRead #-}