{-# 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' :: p (Unwrapped (ToFilePathT f a)) (f (Unwrapped (ToFilePathT f a)))
-> p (ToFilePathT f a) (f (ToFilePathT f a))
_Wrapped' =
    (ToFilePathT f a -> a -> f FilePath)
-> ((a -> f FilePath) -> ToFilePathT f a)
-> Iso
     (ToFilePathT f a)
     (ToFilePathT f a)
     (a -> f FilePath)
     (a -> f FilePath)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(ToFilePathT a -> f FilePath
x) -> a -> f FilePath
x) (a -> f FilePath) -> ToFilePathT f a
forall (f :: * -> *) a. (a -> f FilePath) -> ToFilePathT f a
ToFilePathT
  {-# INLINE _Wrapped' #-}

instance Contravariant (ToFilePathT f) where
  contramap :: (a -> b) -> ToFilePathT f b -> ToFilePathT f a
contramap a -> b
f (ToFilePathT b -> f FilePath
g) =
    (a -> f FilePath) -> ToFilePathT f a
forall (f :: * -> *) a. (a -> f FilePath) -> ToFilePathT f a
ToFilePathT (b -> f FilePath
g (b -> f FilePath) -> (a -> b) -> a -> f FilePath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f)

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

instance Applicative f => Decidable (ToFilePathT f) where
  choose :: (a -> Either b c)
-> ToFilePathT f b -> ToFilePathT f c -> ToFilePathT f a
choose a -> Either b c
f (ToFilePathT b -> f FilePath
g) (ToFilePathT c -> f FilePath
h) =
    (a -> f FilePath) -> ToFilePathT f a
forall (f :: * -> *) a. (a -> f FilePath) -> ToFilePathT f a
ToFilePathT ((b -> f FilePath) -> (c -> f FilePath) -> Either b c -> f FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> f FilePath
g c -> f FilePath
h (Either b c -> f FilePath) -> (a -> Either b c) -> a -> f FilePath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either b c
f)
  lose :: (a -> Void) -> ToFilePathT f a
lose a -> Void
f =
    (a -> f FilePath) -> ToFilePathT f a
forall (f :: * -> *) a. (a -> f FilePath) -> ToFilePathT f a
ToFilePathT (Void -> f FilePath
forall a. Void -> a
absurd (Void -> f FilePath) -> (a -> Void) -> a -> f FilePath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Void
f)

toFilePath ::
  Iso
    (ToFilePath a)
    (ToFilePath a')
    (a -> FilePath)
    (a' -> FilePath)
toFilePath :: p (a -> FilePath) (f (a' -> FilePath))
-> p (ToFilePath a) (f (ToFilePath a'))
toFilePath =
  (ToFilePath a -> a -> FilePath)
-> ((a' -> FilePath) -> ToFilePath a')
-> Iso
     (ToFilePath a) (ToFilePath a') (a -> FilePath) (a' -> FilePath)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\(ToFilePathT a -> Identity FilePath
x) -> Identity FilePath -> FilePath
forall a. Identity a -> a
runIdentity (Identity FilePath -> FilePath)
-> (a -> Identity FilePath) -> a -> FilePath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Identity FilePath
x)
    (\a' -> FilePath
p -> (a' -> Identity FilePath) -> ToFilePath a'
forall (f :: * -> *) a. (a -> f FilePath) -> ToFilePathT f a
ToFilePathT (FilePath -> Identity FilePath
forall a. a -> Identity a
Identity (FilePath -> Identity FilePath)
-> (a' -> FilePath) -> a' -> Identity FilePath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a' -> FilePath
p))
{-# INLINE toFilePath #-}

toRead ::
  Iso
    (ToFilePathT f FilePath)
    (ToFilePathT f' FilePath)
    (ReadFilePathT f FilePath)
    (ReadFilePathT f' FilePath)
toRead :: p (ReadFilePathT f FilePath) (f (ReadFilePathT f' FilePath))
-> p (ToFilePathT f FilePath) (f (ToFilePathT f' FilePath))
toRead =
  (ToFilePathT f FilePath -> ReadFilePathT f FilePath)
-> (ReadFilePathT f' FilePath -> ToFilePathT f' FilePath)
-> Iso
     (ToFilePathT f FilePath)
     (ToFilePathT f' FilePath)
     (ReadFilePathT f FilePath)
     (ReadFilePathT f' FilePath)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\(ToFilePathT FilePath -> f FilePath
x) -> (FilePath -> f FilePath) -> ReadFilePathT f FilePath
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> f FilePath
x)
    (\(ReadFilePathT FilePath -> f' FilePath
x) -> (FilePath -> f' FilePath) -> ToFilePathT f' FilePath
forall (f :: * -> *) a. (a -> f FilePath) -> ToFilePathT f a
ToFilePathT FilePath -> f' FilePath
x)
{-# INLINE toRead #-}