Target.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}

{- | What a build is running the rules on.

A 'Target' is a sum: its constructors are named 'targetFile',
'targetDirectory' and 'targetComplete'.
-}
module Document.Build.Target (
  -- * Type
  KnownFiles,
  Target (..),

  -- * Optics
  TargetLike (..),
  lawNamesTarget,
  InheritTarget,
  inheritTarget,
) where

import Control.DeepSeq (NFData)
import Control.Lens (Choice, Optic, prism', review)
import Data.Data (Data)
import Data.Functor.Const (Const)
import Data.Map (Map)
import Document.Build.Name.TargetComplete (TargetCompleteLike (..))
import Document.Build.Name.TargetDirectory (TargetDirectoryLike (..))
import Document.Build.Name.TargetFile (TargetFileLike (..))
import GHC.Generics (Generic)
import System.FilePather.Trail (Trail)

{- $setup
>>> import Control.Lens (preview)
-}

{- | The files that a build knows: the files of its input directories, with
the empty trail, and the files that the rules made, with their trails, by
normalised path.

@since 0.1.0.0
-}
type KnownFiles = Map FilePath Trail

{- | What a build is running the rules on.

>>> preview targetComplete (TargetComplete mempty)
Just (fromList [])

@since 0.1.0.0
-}
data Target
  = -- | A file: a file of an input directory, or a file the rules made
    -- ('targetFile').
    TargetFile
  | -- | A directory of the output directory ('targetDirectory').
    TargetDirectory
  | -- | The output directory, once, when the rules make no more files, with
    -- every file the build knows ('targetComplete').
    TargetComplete KnownFiles
  deriving stock (Eq, Ord, Show, Generic, Data)
  deriving anyclass (NFData)

{- | The class of 'Target'.

@since 0.2.0.0
-}
class TargetLike p f x x' where
  target ::
    Optic p f x x' Target Target

{- | Identity

@since 0.2.0.0
-}
instance (x' ~ Target) => TargetLike p f Target x' where
  target =
    id
  {-# INLINE target #-}

{- | Prism

@since 0.2.0.0
-}
instance (Choice p, Applicative f, x' ~ Target) => TargetFileLike p f Target x' where
  targetFile =
    prism'
      (\() -> TargetFile)
      ( \case
          TargetFile -> Just ()
          TargetDirectory -> Nothing
          TargetComplete _ -> Nothing
      )
  {-# INLINE targetFile #-}

{- | Prism

@since 0.2.0.0
-}
instance (Choice p, Applicative f, x' ~ Target) => TargetDirectoryLike p f Target x' where
  targetDirectory =
    prism'
      (\() -> TargetDirectory)
      ( \case
          TargetDirectory -> Just ()
          TargetFile -> Nothing
          TargetComplete _ -> Nothing
      )
  {-# INLINE targetDirectory #-}

{- | Prism

@since 0.2.0.0
-}
instance (Choice p, Applicative f, x' ~ Target) => TargetCompleteLike p f Target x' where
  targetComplete =
    prism'
      TargetComplete
      ( \case
          TargetComplete k -> Just k
          TargetFile -> Nothing
          TargetDirectory -> Nothing
      )
  {-# INLINE targetComplete #-}

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

Laws:

> lawNamesTarget == id

@since 0.2.0.0
-}
lawNamesTarget :: Target -> Target
lawNamesTarget = \case
  TargetFile -> review targetFile ()
  TargetDirectory -> review targetDirectory ()
  TargetComplete k -> review targetComplete k

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

@since 0.2.0.0
-}
type InheritTarget s =
  ( TargetLike (->) (Const ()) s s
  , TargetFileLike (->) (Const ()) s s
  , TargetDirectoryLike (->) (Const ()) s s
  , TargetCompleteLike (->) (Const ()) s s
  )

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

@since 0.2.0.0
-}
inheritTarget :: (InheritTarget s) => proxy s -> ()
inheritTarget _ =
  ()