document-build-0.1.0.0: src/Document/Build/Context.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

{- | The context that rules run in, and the combinators that make rules and
choose the files they apply to.

A 'Rules' value is a function of the 'Context' of a build, to a 'Tracked'
build step. The build (see "Document.Build.Documents") runs it on every file
of its input directories, then on every file it makes, until it makes no
more; then on every directory of the output directory, and so on, until
nothing new is made; then once more, on the output directory, when the build
is complete. Rules combine with '<>', which runs both:

@
'Document.Build.Rules.pageCountRules' (\<> ".pages")
  <> 'onProject' "group/project" ('Document.Build.Rules.splitPdf' "report.pdf" [("1", "report_cover.pdf")])
@
-}
module Document.Build.Context (
  -- * Directories
  Directories (..),
  outputDirectory,
  inputDirectories,
  fontsDirectory,
  GetDirectories (..),
  HasDirectories (..),
  ReviewDirectories (..),
  AsDirectories (..),

  -- * Targets
  KnownFiles,
  Target (..),
  _TargetFile,
  _TargetDirectory,
  _TargetComplete,
  GetTarget (..),
  HasTarget (..),
  ReviewTarget (..),
  AsTarget (..),

  -- * Context
  Context (..),
  contextDirectories,
  contextProject,
  contextTarget,
  GetContext (..),
  HasContext (..),
  ReviewContext (..),
  AsContext (..),

  -- * Rules
  Rules,
  fromTracked,
  buildStep,
  buildStep',

  -- * Choosing files
  onProject,
  onProjects,
  withProject,
  onPaths,
  onFiles,
  onDirectories,
  onComplete,
  onSources,
  onOutputs,
  afterStep,
  unlessAfterStep,
) where

import Control.DeepSeq (NFData)
import Control.Lens (Field1, Field2, Field3, Getter, Lens', Prism', Review, lens, preview, prism', review, unto, view, (^.), _1, _2, _3, _Wrapped)
import Data.Bool (bool)
import Data.Data (Data)
import Data.Lens.Injection (Injection1 (..), Injection2 (..), Injection3 (..))
import Data.Map (Map)
import Document.Build.Build (Build', Command', io)
import GHC.Generics (Generic)
import System.Directory (doesFileExist)
import System.FilePather.Combinators (isWithin)
import System.FilePather.FilePather (FilePather (..))
import System.FilePather.Tracked (Tracked, step, step', whenPath, whenTrail)
import System.FilePather.Trail (Trail, lastStep, stepName)

{- $setup
>>> import Control.Lens ((^.), (&), (.~), (^?))
-}

{- | The directories of a build: the output directory, which the build removes
and writes to; the input directories, whose files the rules run on, in
order; and the fonts directory, whose fonts LibreOffice uses during the
build, if there is one.

>>> Directories "public" ["src"] Nothing ^. outputDirectory
"public"

>>> (Directories "public" ["src"] Nothing & fontsDirectory .~ Just "fonts") ^. fontsDirectory
Just "fonts"

@since 0.1.0.0
-}
data Directories
  = Directories FilePath [FilePath] (Maybe FilePath)
  deriving stock (Eq, Ord, Show, Generic, Data)
  deriving anyclass (NFData)

-- | @since 0.1.0.0
instance Field1 Directories Directories FilePath FilePath

-- | @since 0.1.0.0
instance Field2 Directories Directories [FilePath] [FilePath]

-- | @since 0.1.0.0
instance Field3 Directories Directories (Maybe FilePath) (Maybe FilePath)

{- | The directory that the build writes to. It is removed at the start of
the build, and every file the rules make must be in it.

@since 0.1.0.0
-}
outputDirectory :: Lens' Directories FilePath
outputDirectory =
  _1
{-# INLINE outputDirectory #-}

{- | The directories whose files the rules run on, in order: when two files
make the same file, the first is kept.

@since 0.1.0.0
-}
inputDirectories :: Lens' Directories [FilePath]
inputDirectories =
  _2
{-# INLINE inputDirectories #-}

{- | The directory of fonts that LibreOffice uses during the build, if there
is one (see 'Document.Build.Project.withFonts').

@since 0.1.0.0
-}
fontsDirectory :: Lens' Directories (Maybe FilePath)
fontsDirectory =
  _3
{-# INLINE fontsDirectory #-}

-- | @since 0.1.0.0
class GetDirectories s where
  getDirectories :: Getter s Directories

-- | @since 0.1.0.0
instance GetDirectories Directories where
  getDirectories =
    id
  {-# INLINE getDirectories #-}

-- | @since 0.1.0.0
class (GetDirectories s) => HasDirectories s where
  {-# MINIMAL setDirectories #-}
  setDirectories :: Directories -> s -> s

  directories :: Lens' s Directories
  directories =
    lens (view getDirectories) (flip setDirectories)
  {-# INLINE directories #-}

-- | @since 0.1.0.0
instance HasDirectories Directories where
  setDirectories =
    const
  {-# INLINE setDirectories #-}

-- | @since 0.1.0.0
class ReviewDirectories t where
  reviewDirectories :: Review t Directories

-- | @since 0.1.0.0
instance ReviewDirectories Directories where
  reviewDirectories =
    unto id
  {-# INLINE reviewDirectories #-}

-- | @since 0.1.0.0
class (ReviewDirectories t) => AsDirectories t where
  {-# MINIMAL matchDirectories #-}
  matchDirectories :: t -> Maybe Directories

  _Directories :: Prism' t Directories
  _Directories =
    prism' (review reviewDirectories) matchDirectories
  {-# INLINE _Directories #-}

-- | @since 0.1.0.0
instance AsDirectories Directories where
  matchDirectories =
    Just
  {-# INLINE matchDirectories #-}

{- | 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.

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

-- | @since 0.1.0.0
instance Injection1 Target Target () ()

-- | @since 0.1.0.0
instance Injection2 Target Target () ()

-- | @since 0.1.0.0
instance Injection3 Target Target KnownFiles KnownFiles

-- | @since 0.1.0.0
_TargetFile :: Prism' Target ()
_TargetFile =
  _I1
{-# INLINE _TargetFile #-}

-- | @since 0.1.0.0
_TargetDirectory :: Prism' Target ()
_TargetDirectory =
  _I2
{-# INLINE _TargetDirectory #-}

{- | >>> TargetComplete mempty ^? _TargetComplete
Just (fromList [])

@since 0.1.0.0
-}
_TargetComplete :: Prism' Target KnownFiles
_TargetComplete =
  _I3
{-# INLINE _TargetComplete #-}

-- | @since 0.1.0.0
class GetTarget s where
  getTarget :: Getter s Target

-- | @since 0.1.0.0
instance GetTarget Target where
  getTarget =
    id
  {-# INLINE getTarget #-}

-- | @since 0.1.0.0
class (GetTarget s) => HasTarget s where
  {-# MINIMAL setTarget #-}
  setTarget :: Target -> s -> s

  target :: Lens' s Target
  target =
    lens (view getTarget) (flip setTarget)
  {-# INLINE target #-}

-- | @since 0.1.0.0
instance HasTarget Target where
  setTarget =
    const
  {-# INLINE setTarget #-}

-- | @since 0.1.0.0
class ReviewTarget t where
  reviewTarget :: Review t Target

-- | @since 0.1.0.0
instance ReviewTarget Target where
  reviewTarget =
    unto id
  {-# INLINE reviewTarget #-}

-- | @since 0.1.0.0
class (ReviewTarget t) => AsTarget t where
  {-# MINIMAL matchTarget #-}
  matchTarget :: t -> Maybe Target

  _Target :: Prism' t Target
  _Target =
    prism' (review reviewTarget) matchTarget
  {-# INLINE _Target #-}

-- | @since 0.1.0.0
instance AsTarget Target where
  matchTarget =
    Just
  {-# INLINE matchTarget #-}

{- | The context that rules are run in: the directories of the build, the
path of the project (see 'Document.Build.Project.projectPath'), and what the
rules are running on.

@since 0.1.0.0
-}
data Context
  = Context Directories String Target
  deriving stock (Eq, Ord, Show, Generic, Data)
  deriving anyclass (NFData)

-- | @since 0.1.0.0
instance Field1 Context Context Directories Directories

-- | @since 0.1.0.0
instance Field2 Context Context String String

-- | @since 0.1.0.0
instance Field3 Context Context Target Target

-- | @since 0.1.0.0
contextDirectories :: Lens' Context Directories
contextDirectories =
  _1
{-# INLINE contextDirectories #-}

-- | @since 0.1.0.0
contextProject :: Lens' Context String
contextProject =
  _2
{-# INLINE contextProject #-}

-- | @since 0.1.0.0
contextTarget :: Lens' Context Target
contextTarget =
  _3
{-# INLINE contextTarget #-}

-- | @since 0.1.0.0
class GetContext s where
  getContext :: Getter s Context

-- | @since 0.1.0.0
instance GetContext Context where
  getContext =
    id
  {-# INLINE getContext #-}

-- | @since 0.1.0.0
class (GetContext s) => HasContext s where
  {-# MINIMAL setContext #-}
  setContext :: Context -> s -> s

  context :: Lens' s Context
  context =
    lens (view getContext) (flip setContext)
  {-# INLINE context #-}

-- | @since 0.1.0.0
instance HasContext Context where
  setContext =
    const
  {-# INLINE setContext #-}

-- | @since 0.1.0.0
instance GetDirectories Context where
  getDirectories =
    contextDirectories
  {-# INLINE getDirectories #-}

-- | @since 0.1.0.0
instance HasDirectories Context where
  setDirectories d (Context _ p t) =
    Context d p t
  {-# INLINE setDirectories #-}

-- | @since 0.1.0.0
instance GetTarget Context where
  getTarget =
    contextTarget
  {-# INLINE getTarget #-}

-- | @since 0.1.0.0
instance HasTarget Context where
  setTarget t (Context d p _) =
    Context d p t
  {-# INLINE setTarget #-}

-- | @since 0.1.0.0
class ReviewContext t where
  reviewContext :: Review t Context

-- | @since 0.1.0.0
instance ReviewContext Context where
  reviewContext =
    unto id
  {-# INLINE reviewContext #-}

-- | @since 0.1.0.0
class (ReviewContext t) => AsContext t where
  {-# MINIMAL matchContext #-}
  matchContext :: t -> Maybe Context

  _Context :: Prism' t Context
  _Context =
    prism' (review reviewContext) matchContext
  {-# INLINE _Context #-}

-- | @since 0.1.0.0
instance AsContext Context where
  matchContext =
    Just
  {-# INLINE matchContext #-}

{- | The rules of a build: a function of its context, to the build steps to
run on a file or directory. Rules combine with '<>', which runs both, and
'mempty' is no rules.

@since 0.1.0.0
-}
type Rules = Context -> Tracked Build' ()

{- | Rules that do not depend on the context.

@since 0.1.0.0
-}
fromTracked :: Tracked Build' () -> Rules
fromTracked =
  const
{-# INLINE fromTracked #-}

{- | A named step that runs a command, which makes the files given by a
function of its input file. See 'System.FilePather.Tracked.step'.

The command is not run if one of the files already exists, because the build
removes the output directory first, so another step made it in this build:
the first step to make a file keeps it.

@since 0.1.0.0
-}
buildStep :: (Monoid a) => String -> (FilePath -> [FilePath]) -> Command' a -> Tracked Build' a
buildStep n outs c =
  step n outs $
    FilePather $ \p ->
      io (or <$> traverse doesFileExist (outs p))
        >>= bool (view _Wrapped c p) (pure mempty)

{- | A named step that runs a command, which returns the files it made. See
'System.FilePather.Tracked.step''.

@since 0.1.0.0
-}
buildStep' :: String -> Command' [FilePath] -> Tracked Build' ()
buildStep' n c =
  step' n (fmap (,()) c)

{- | Rules for one project, by its path, such as @"group/project"@.

@since 0.1.0.0
-}
onProject :: String -> Rules -> Rules
onProject p =
  onProjects (== p)
{-# INLINE onProject #-}

{- | Rules for the projects whose paths satisfy a predicate.

@since 0.1.0.0
-}
onProjects :: (String -> Bool) -> Rules -> Rules
onProjects f r c =
  bool mempty (r c) (f (c ^. contextProject))
{-# INLINE onProjects #-}

{- | Rules that depend on the path of the project, such as rules with
different placeholders for some projects.

@since 0.1.0.0
-}
withProject :: (String -> Rules) -> Rules
withProject f c =
  f (c ^. contextProject) c
{-# INLINE withProject #-}

{- | Rules for the files and directories whose paths satisfy a predicate.

@since 0.1.0.0
-}
onPaths :: (FilePath -> Bool) -> Rules -> Rules
onPaths f r =
  whenPath f . r
{-# INLINE onPaths #-}

{- | Rules for files: the files of the input directories, and the files that
rules make.

@since 0.1.0.0
-}
onFiles :: Rules -> Rules
onFiles r c =
  maybe mempty (const (r c)) (preview (contextTarget . _TargetFile) c)
{-# INLINE onFiles #-}

{- | Rules for the directories of the output directory, which run after the
rules for files have made every file they can.

@since 0.1.0.0
-}
onDirectories :: Rules -> Rules
onDirectories r c =
  maybe mempty (const (r c)) (preview (contextTarget . _TargetDirectory) c)
{-# INLINE onDirectories #-}

{- | Rules that run once, on the output directory, when the rules make no
more files, given every file the build knows. The files they make are not
given to any rules.

@since 0.1.0.0
-}
onComplete :: (KnownFiles -> Rules) -> Rules
onComplete r c =
  maybe mempty (`r` c) (preview (contextTarget . _TargetComplete) c)
{-# INLINE onComplete #-}

{- | Rules for the files of the input directories only: files with the empty
trail.

@since 0.1.0.0
-}
onSources :: Rules -> Rules
onSources r =
  whenTrail (null . preview lastStep) . r
{-# INLINE onSources #-}

{- | Rules for the files and directories in the output directory. Every rule
that makes files from files the rules made, rather than from the files of the
input directories, should apply only to these, so that the input directories
are not changed.

@since 0.1.0.0
-}
onOutputs :: Rules -> Rules
onOutputs r c =
  whenPath (isWithin (c ^. contextDirectories . outputDirectory)) (r c)
{-# INLINE onOutputs #-}

{- | Rules for files made by a step whose name satisfies a predicate.

@since 0.1.0.0
-}
afterStep :: (String -> Bool) -> Rules -> Rules
afterStep f r =
  whenTrail (any f . preview (lastStep . stepName)) . r
{-# INLINE afterStep #-}

{- | Rules for the files of the input directories, and files made by a step
whose name does not satisfy a predicate.

@since 0.1.0.0
-}
unlessAfterStep :: (String -> Bool) -> Rules -> Rules
unlessAfterStep f r =
  whenTrail (not . any f . preview (lastStep . stepName)) . r
{-# INLINE unlessAfterStep #-}