{-# LANGUAGE UndecidableInstances #-}
module Effectful.FileSystem.PathWriter.Utils
(
CopyDirConfig (..),
defaultCopyDirConfig,
Overwrite (..),
TargetName (..),
_OverwriteNone,
_OverwriteDirectories,
_OverwriteAll,
_TargetNameSrc,
_TargetNameLiteral,
_TargetNameDest,
)
where
import Control.DeepSeq (NFData)
import FileSystem.OsPath (OsPath)
import GHC.Generics (Generic)
import Optics.Core
( A_Lens,
LabelOptic (labelOptic),
Prism',
lensVL,
prism,
)
data Overwrite
=
OverwriteNone
|
OverwriteDirectories
|
OverwriteAll
deriving stock
(
Overwrite -> Overwrite -> Bool
(Overwrite -> Overwrite -> Bool)
-> (Overwrite -> Overwrite -> Bool) -> Eq Overwrite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Overwrite -> Overwrite -> Bool
== :: Overwrite -> Overwrite -> Bool
$c/= :: Overwrite -> Overwrite -> Bool
/= :: Overwrite -> Overwrite -> Bool
Eq,
(forall x. Overwrite -> Rep Overwrite x)
-> (forall x. Rep Overwrite x -> Overwrite) -> Generic Overwrite
forall x. Rep Overwrite x -> Overwrite
forall x. Overwrite -> Rep Overwrite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Overwrite -> Rep Overwrite x
from :: forall x. Overwrite -> Rep Overwrite x
$cto :: forall x. Rep Overwrite x -> Overwrite
to :: forall x. Rep Overwrite x -> Overwrite
Generic,
Int -> Overwrite -> ShowS
[Overwrite] -> ShowS
Overwrite -> String
(Int -> Overwrite -> ShowS)
-> (Overwrite -> String)
-> ([Overwrite] -> ShowS)
-> Show Overwrite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Overwrite -> ShowS
showsPrec :: Int -> Overwrite -> ShowS
$cshow :: Overwrite -> String
show :: Overwrite -> String
$cshowList :: [Overwrite] -> ShowS
showList :: [Overwrite] -> ShowS
Show
)
deriving anyclass
(
Overwrite -> ()
(Overwrite -> ()) -> NFData Overwrite
forall a. (a -> ()) -> NFData a
$crnf :: Overwrite -> ()
rnf :: Overwrite -> ()
NFData
)
_OverwriteNone :: Prism' Overwrite ()
_OverwriteNone :: Prism' Overwrite ()
_OverwriteNone =
(() -> Overwrite)
-> (Overwrite -> Either Overwrite ()) -> Prism' Overwrite ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(\() -> Overwrite
OverwriteNone)
( \Overwrite
x -> case Overwrite
x of
Overwrite
OverwriteNone -> () -> Either Overwrite ()
forall a b. b -> Either a b
Right ()
Overwrite
_ -> Overwrite -> Either Overwrite ()
forall a b. a -> Either a b
Left Overwrite
x
)
{-# INLINE _OverwriteNone #-}
_OverwriteDirectories :: Prism' Overwrite ()
_OverwriteDirectories :: Prism' Overwrite ()
_OverwriteDirectories =
(() -> Overwrite)
-> (Overwrite -> Either Overwrite ()) -> Prism' Overwrite ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(\() -> Overwrite
OverwriteDirectories)
( \Overwrite
x -> case Overwrite
x of
Overwrite
OverwriteDirectories -> () -> Either Overwrite ()
forall a b. b -> Either a b
Right ()
Overwrite
_ -> Overwrite -> Either Overwrite ()
forall a b. a -> Either a b
Left Overwrite
x
)
{-# INLINE _OverwriteDirectories #-}
_OverwriteAll :: Prism' Overwrite ()
_OverwriteAll :: Prism' Overwrite ()
_OverwriteAll =
(() -> Overwrite)
-> (Overwrite -> Either Overwrite ()) -> Prism' Overwrite ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(\() -> Overwrite
OverwriteAll)
( \Overwrite
x -> case Overwrite
x of
Overwrite
OverwriteAll -> () -> Either Overwrite ()
forall a b. b -> Either a b
Right ()
Overwrite
_ -> Overwrite -> Either Overwrite ()
forall a b. a -> Either a b
Left Overwrite
x
)
{-# INLINE _OverwriteAll #-}
data TargetName
=
TargetNameSrc
|
TargetNameLiteral !OsPath
|
TargetNameDest
deriving stock
(
TargetName -> TargetName -> Bool
(TargetName -> TargetName -> Bool)
-> (TargetName -> TargetName -> Bool) -> Eq TargetName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TargetName -> TargetName -> Bool
== :: TargetName -> TargetName -> Bool
$c/= :: TargetName -> TargetName -> Bool
/= :: TargetName -> TargetName -> Bool
Eq,
(forall x. TargetName -> Rep TargetName x)
-> (forall x. Rep TargetName x -> TargetName) -> Generic TargetName
forall x. Rep TargetName x -> TargetName
forall x. TargetName -> Rep TargetName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TargetName -> Rep TargetName x
from :: forall x. TargetName -> Rep TargetName x
$cto :: forall x. Rep TargetName x -> TargetName
to :: forall x. Rep TargetName x -> TargetName
Generic,
Int -> TargetName -> ShowS
[TargetName] -> ShowS
TargetName -> String
(Int -> TargetName -> ShowS)
-> (TargetName -> String)
-> ([TargetName] -> ShowS)
-> Show TargetName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TargetName -> ShowS
showsPrec :: Int -> TargetName -> ShowS
$cshow :: TargetName -> String
show :: TargetName -> String
$cshowList :: [TargetName] -> ShowS
showList :: [TargetName] -> ShowS
Show
)
deriving anyclass
(
TargetName -> ()
(TargetName -> ()) -> NFData TargetName
forall a. (a -> ()) -> NFData a
$crnf :: TargetName -> ()
rnf :: TargetName -> ()
NFData
)
_TargetNameSrc :: Prism' TargetName ()
_TargetNameSrc :: Prism' TargetName ()
_TargetNameSrc =
(() -> TargetName)
-> (TargetName -> Either TargetName ()) -> Prism' TargetName ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(\() -> TargetName
TargetNameSrc)
( \TargetName
x -> case TargetName
x of
TargetName
TargetNameSrc -> () -> Either TargetName ()
forall a b. b -> Either a b
Right ()
TargetName
_ -> TargetName -> Either TargetName ()
forall a b. a -> Either a b
Left TargetName
x
)
{-# INLINE _TargetNameSrc #-}
_TargetNameLiteral :: Prism' TargetName OsPath
_TargetNameLiteral :: Prism' TargetName OsPath
_TargetNameLiteral =
(OsPath -> TargetName)
-> (TargetName -> Either TargetName OsPath)
-> Prism' TargetName OsPath
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
OsPath -> TargetName
TargetNameLiteral
( \TargetName
x -> case TargetName
x of
TargetNameLiteral OsPath
p -> OsPath -> Either TargetName OsPath
forall a b. b -> Either a b
Right OsPath
p
TargetName
_ -> TargetName -> Either TargetName OsPath
forall a b. a -> Either a b
Left TargetName
x
)
{-# INLINE _TargetNameLiteral #-}
_TargetNameDest :: Prism' TargetName ()
_TargetNameDest :: Prism' TargetName ()
_TargetNameDest =
(() -> TargetName)
-> (TargetName -> Either TargetName ()) -> Prism' TargetName ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(\() -> TargetName
TargetNameDest)
( \TargetName
x -> case TargetName
x of
TargetName
TargetNameDest -> () -> Either TargetName ()
forall a b. b -> Either a b
Right ()
TargetName
_ -> TargetName -> Either TargetName ()
forall a b. a -> Either a b
Left TargetName
x
)
{-# INLINE _TargetNameDest #-}
data CopyDirConfig = MkCopyDirConfig
{
CopyDirConfig -> Overwrite
overwrite :: !Overwrite,
CopyDirConfig -> TargetName
targetName :: !TargetName
}
deriving stock
(
CopyDirConfig -> CopyDirConfig -> Bool
(CopyDirConfig -> CopyDirConfig -> Bool)
-> (CopyDirConfig -> CopyDirConfig -> Bool) -> Eq CopyDirConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CopyDirConfig -> CopyDirConfig -> Bool
== :: CopyDirConfig -> CopyDirConfig -> Bool
$c/= :: CopyDirConfig -> CopyDirConfig -> Bool
/= :: CopyDirConfig -> CopyDirConfig -> Bool
Eq,
(forall x. CopyDirConfig -> Rep CopyDirConfig x)
-> (forall x. Rep CopyDirConfig x -> CopyDirConfig)
-> Generic CopyDirConfig
forall x. Rep CopyDirConfig x -> CopyDirConfig
forall x. CopyDirConfig -> Rep CopyDirConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CopyDirConfig -> Rep CopyDirConfig x
from :: forall x. CopyDirConfig -> Rep CopyDirConfig x
$cto :: forall x. Rep CopyDirConfig x -> CopyDirConfig
to :: forall x. Rep CopyDirConfig x -> CopyDirConfig
Generic,
Int -> CopyDirConfig -> ShowS
[CopyDirConfig] -> ShowS
CopyDirConfig -> String
(Int -> CopyDirConfig -> ShowS)
-> (CopyDirConfig -> String)
-> ([CopyDirConfig] -> ShowS)
-> Show CopyDirConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyDirConfig -> ShowS
showsPrec :: Int -> CopyDirConfig -> ShowS
$cshow :: CopyDirConfig -> String
show :: CopyDirConfig -> String
$cshowList :: [CopyDirConfig] -> ShowS
showList :: [CopyDirConfig] -> ShowS
Show
)
deriving anyclass
(
CopyDirConfig -> ()
(CopyDirConfig -> ()) -> NFData CopyDirConfig
forall a. (a -> ()) -> NFData a
$crnf :: CopyDirConfig -> ()
rnf :: CopyDirConfig -> ()
NFData
)
instance
(k ~ A_Lens, a ~ Overwrite, b ~ Overwrite) =>
LabelOptic "overwrite" k CopyDirConfig CopyDirConfig a b
where
labelOptic :: Optic k NoIx CopyDirConfig CopyDirConfig a b
labelOptic = LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b)
-> LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCopyDirConfig Overwrite
a1 TargetName
a2) ->
(Overwrite -> CopyDirConfig) -> f Overwrite -> f CopyDirConfig
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Overwrite
b -> Overwrite -> TargetName -> CopyDirConfig
MkCopyDirConfig Overwrite
b TargetName
a2) (a -> f b
f a
Overwrite
a1)
{-# INLINE labelOptic #-}
instance
(k ~ A_Lens, a ~ TargetName, b ~ TargetName) =>
LabelOptic "targetName" k CopyDirConfig CopyDirConfig a b
where
labelOptic :: Optic k NoIx CopyDirConfig CopyDirConfig a b
labelOptic = LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b)
-> LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCopyDirConfig Overwrite
a1 TargetName
a2) ->
(TargetName -> CopyDirConfig) -> f TargetName -> f CopyDirConfig
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TargetName
b -> Overwrite -> TargetName -> CopyDirConfig
MkCopyDirConfig Overwrite
a1 TargetName
b) (a -> f b
f a
TargetName
a2)
{-# INLINE labelOptic #-}
defaultCopyDirConfig :: CopyDirConfig
defaultCopyDirConfig :: CopyDirConfig
defaultCopyDirConfig = Overwrite -> TargetName -> CopyDirConfig
MkCopyDirConfig Overwrite
OverwriteNone TargetName
TargetNameSrc