filepather-0.8.0.0: src/System/FilePather/FilePather.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- Required for the MonadState, MonadWriter and MonadError instances: the
-- functional dependency of each class (for example, m -> s) is not covered by
-- the instance head MonadState s (FilePather f), because s does not occur in
-- FilePather f.
-- Terminates: each instance context is the same class at f, which is a strict
-- subterm of the instance head FilePather f, so resolution moves to a smaller
-- type at each step.
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}

{- | A 'FilePather' is a computation that depends on the file path being
operated on, producing a value in a type constructor @f@.

@
newtype FilePather f a = FilePather (FilePath -> f a)
@

A 'FilePather' is a product with one field, named 'pathFunction'. It is
isomorphic to @ReaderT FilePath f a@ (see
'filePatherReaderT'), and has the same instances. In particular, when @f@ is a
'Monad', so is @FilePather f@, and 'Control.Monad.Reader.ask' returns the file path being operated
on.
-}
module System.FilePather.FilePather (
  -- * Types
  FilePather (..),

  -- * Type aliases
  FilePather',
  FilePatherIO,
  FilePatherMaybe,
  FilePatherList,
  FilePatherNonEmpty,
  FilePatherEither,
  FilePatherMaybeT,
  FilePatherExceptT,
  FilePatherExitcode,
  FilePatherExitcode',

  -- * Isomorphisms
  filePatherReaderT,

  -- * Optics
  FilePatherLike (..),
  lawNamesFilePather,
  InheritFilePather,
  inheritFilePather,

  -- * Fusion workers
  mapFilePather,
  mapMaybeFilePather,
) where

import Control.Applicative (Alternative)
import Control.DeepSeq (NFData)
import Control.Exitcode (Exitcode)
import Control.Lens (Iso, Optic, cloneLens, iso, view)
import Control.Monad (MonadPlus)
import Control.Monad.Cont.Class (MonadCont)
import Control.Monad.Error.Class (MonadError)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT (..))
import Control.Monad.Reader.Class (MonadReader)
import Control.Monad.State.Class (MonadState)
import Control.Monad.Trans.Class (MonadTrans)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Writer.Class (MonadWriter)
import Control.Monad.Zip (MonadZip)
import Control.Selective (Selective)
import Data.Distributive (Distributive (..))
import Data.Functor.Alt (Alt (..))
import Data.Functor.Apply (Apply)
import Data.Functor.Bind (Bind (..))
import Data.Functor.Const (Const)
import Data.Functor.Contravariant (Contravariant)
import Data.Functor.Contravariant.Divisible (Decidable, Divisible)
import Data.Functor.Identity (Identity)
import Data.Functor.Plus (Plus)
import Data.Functor.Rep (Representable (..))
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import GHC.Generics (Generic, Generic1)
import System.FilePather.Name.PathFunction (PathFunctionLike (..))
import Witherable (Filterable (..))

{- $setup
>>> import Control.Lens (cloneLens, view)
>>> import Control.Monad.Reader (ask, asks)
>>> import Data.Functor.Identity (Identity (..))
>>> import System.FilePath (takeExtension)
>>> import Witherable (mapMaybe)
-}

{- | A computation that depends on the file path being operated on.

The file path is typically an input file, and the result is typically one or
more output files, or some information about the input file. Use 'Control.Monad.Reader.ask' for the
file path, and 'Control.Monad.Reader.local' to operate on a different file path.

==== __Examples__

>>> runIdentity (view (cloneLens pathFunction) (asks takeExtension :: FilePather' String) "notes.md")
".md"

>>> view (cloneLens pathFunction) (FilePather (\p -> [p, p ++ ".bak"])) "notes.md"
["notes.md","notes.md.bak"]

>>> runIdentity (view (cloneLens pathFunction) ((,) <$> ask <*> asks length :: FilePather' (FilePath, Int)) "notes.md")
("notes.md",8)

@since 0.7.0.0
-}
type FilePather :: (Type -> Type) -> Type -> Type
newtype FilePather f a
  = FilePather (FilePath -> f a)
  deriving stock (Generic, Generic1)
  deriving newtype (NFData)
  deriving
    ( Apply
    , Applicative
    , Alternative
    , Plus
    , Monad
    , MonadPlus
    , MonadFail
    , MonadFix
    , MonadZip
    , MonadIO
    , MonadCont
    , MonadReader FilePath
    , Selective
    , Contravariant
    , Divisible
    , Decidable
    )
    via (ReaderT FilePath f)
  deriving (Semigroup, Monoid) via (FilePath -> f a)

deriving via (ReaderT FilePath) instance MonadTrans FilePather

deriving via (ReaderT FilePath f) instance (MonadState s f) => MonadState s (FilePather f)

deriving via (ReaderT FilePath f) instance (MonadWriter w f) => MonadWriter w (FilePather f)

deriving via (ReaderT FilePath f) instance (MonadError e f) => MonadError e (FilePather f)

{- | A 'FilePather' that produces a value without effects.

@since 0.7.0.0
-}
type FilePather' a = FilePather Identity a

-- | @since 0.7.0.0
type FilePatherIO a = FilePather IO a

-- | @since 0.7.0.0
type FilePatherMaybe a = FilePather Maybe a

-- | @since 0.7.0.0
type FilePatherList a = FilePather [] a

-- | @since 0.7.0.0
type FilePatherNonEmpty a = FilePather NonEmpty a

-- | @since 0.7.0.0
type FilePatherEither e a = FilePather (Either e) a

-- | @since 0.7.0.0
type FilePatherMaybeT f a = FilePather (MaybeT f) a

-- | @since 0.7.0.0
type FilePatherExceptT e f a = FilePather (ExceptT e f) a

{- | A 'FilePather' that fails with an exit code, using 'Exitcode'.

@since 0.7.0.0
-}
type FilePatherExitcode e f a = FilePather (Exitcode e f) a

-- | @since 0.7.0.0
type FilePatherExitcode' e a = FilePather (Exitcode e Identity) a

{- | Map over the result of a 'FilePather'. This is 'fmap', and is the
function that the fusion rules match.

>>> runIdentity (view (cloneLens pathFunction) (mapFilePather length ask) "notes.md")
8

@since 0.7.0.0
-}
mapFilePather :: (Functor f) => (a -> b) -> FilePather f a -> FilePather f b
mapFilePather f (FilePather g) =
  FilePather (fmap f . g)
{-# NOINLINE [1] mapFilePather #-}

{- | Filter and map over the result of a 'FilePather'. This is 'mapMaybe', and
is the function that the fusion rules match.

>>> view (cloneLens pathFunction) (mapMaybeFilePather (\x -> if x > 1 then Just (x * 10) else Nothing) (FilePather (\p -> [1, length p]))) "abc"
[30]

@since 0.7.0.0
-}
mapMaybeFilePather :: (Filterable f) => (a -> Maybe b) -> FilePather f a -> FilePather f b
mapMaybeFilePather f (FilePather g) =
  FilePather (mapMaybe f . g)
{-# NOINLINE [1] mapMaybeFilePather #-}

{-# RULES
"mapFilePather/mapFilePather" [~1] forall f g x.
  mapFilePather f (mapFilePather g x) =
    mapFilePather (f . g) x
"mapMaybeFilePather/mapMaybeFilePather" [~1] forall f g x.
  mapMaybeFilePather f (mapMaybeFilePather g x) =
    mapMaybeFilePather (\a -> g a >>= f) x
"mapMaybeFilePather/mapFilePather" [~1] forall f g x.
  mapMaybeFilePather f (mapFilePather g x) =
    mapMaybeFilePather (f . g) x
  #-}

-- | @since 0.7.0.0
instance (Functor f) => Functor (FilePather f) where
  fmap =
    mapFilePather
  {-# INLINE fmap #-}

-- | @since 0.7.0.0
instance (Bind f) => Bind (FilePather f) where
  FilePather g >>- k =
    FilePather (\p -> g p >>- \a -> view (cloneLens pathFunction) (k a) p)
  {-# INLINE (>>-) #-}

-- | @since 0.7.0.0
instance (Alt f) => Alt (FilePather f) where
  FilePather g <!> FilePather h =
    FilePather (\p -> g p <!> h p)
  {-# INLINE (<!>) #-}

-- | @since 0.7.0.0
instance (Filterable f) => Filterable (FilePather f) where
  mapMaybe =
    mapMaybeFilePather
  {-# INLINE mapMaybe #-}

-- | @since 0.7.0.0
instance (Distributive f) => Distributive (FilePather f) where
  distribute w =
    FilePather (\p -> distribute (fmap (\x -> view (cloneLens pathFunction) x p) w))
  {-# INLINE distribute #-}

{- | The representation pairs the file path with the representation of @f@.

@since 0.7.0.0
-}
instance (Representable f) => Representable (FilePather f) where
  type Rep (FilePather f) = (FilePath, Rep f)
  tabulate h =
    FilePather (\p -> tabulate (\r -> h (p, r)))
  {-# INLINE tabulate #-}
  index (FilePather g) (p, r) =
    index (g p) r
  {-# INLINE index #-}

{- | The isomorphism between 'FilePather' and 'ReaderT'.

>>> runIdentity (runReaderT (view filePatherReaderT (asks length)) "notes.md")
8

@since 0.7.0.0
-}
filePatherReaderT :: Iso (FilePather f a) (FilePather g b) (ReaderT FilePath f a) (ReaderT FilePath g b)
filePatherReaderT =
  iso (\(FilePather g) -> ReaderT g) (\(ReaderT g) -> FilePather g)
{-# INLINE filePatherReaderT #-}

{- | The class of 'FilePather', with a pair of type variables for each of
its two parameters.

>>> runIdentity (view (cloneLens (filePather . pathFunction)) (asks length :: FilePather' Int) "notes.md")
8

@since 0.8.0.0
-}
class FilePatherLike p f x x' g g' a a' | x -> g a where
  filePather ::
    Optic p f x x' (FilePather g a) (FilePather g' a')

{- | Identity

@since 0.8.0.0
-}
instance (x' ~ FilePather g' a') => FilePatherLike p f (FilePather g a) x' g g' a a' where
  filePather =
    id
  {-# INLINE filePather #-}

{- | Lens

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ FilePather g' a') => PathFunctionLike p f (FilePather g a) x' g g' a a' where
  pathFunction f (FilePather k) =
    fmap FilePather (f k)
  {-# INLINE pathFunction #-}

{- | Rebuild a value using only the name of each field.

Laws, for every file path @p@:

> view (cloneLens pathFunction) (lawNamesFilePather x) p == view (cloneLens pathFunction) x p

@since 0.8.0.0
-}
lawNamesFilePather :: FilePather g a -> FilePather g a
lawNamesFilePather s =
  FilePather (view (cloneLens pathFunction) s)

{- | The classes that a data type holding 'FilePather' inherits.

@since 0.8.0.0
-}
type InheritFilePather s g a =
  ( FilePatherLike (->) (Const ()) s s g g a a
  , PathFunctionLike (->) (Const ()) s s g g a a
  )

{- | Check, where it is applied, that @s@ inherits every name of
'FilePather'.

@since 0.8.0.0
-}
inheritFilePather :: (InheritFilePather s g a) => proxy s -> ()
inheritFilePather _ =
  ()