CommandLine.hs

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

{- | A program and its arguments.

A 'CommandLine' is a product: its fields are named 'commandLineProgram' and
'commandLineArguments'.
-}
module Document.Build.CommandLine (
  -- * Type
  CommandLine (..),

  -- * Display
  displayCommandLine,
  shellQuote,

  -- * Optics
  CommandLineLike (..),
  lawNamesCommandLine,
  InheritCommandLine,
  inheritCommandLine,
) where

import Control.DeepSeq (NFData)
import Control.Lens (Optic, cloneLens, view)
import Data.Data (Data)
import Data.Functor.Const (Const)
import Document.Build.Name.CommandLineArguments (CommandLineArgumentsLike (..))
import Document.Build.Name.CommandLineProgram (CommandLineProgramLike (..))
import GHC.Generics (Generic)

{- $setup
>>> import Control.Lens (cloneLens, view)
-}

{- | A program ('commandLineProgram') and its arguments
('commandLineArguments').

>>> view (cloneLens commandLineProgram) (CommandLine "pdfinfo" ["my file.pdf"])
"pdfinfo"

>>> view (cloneLens commandLineArguments) (CommandLine "pdfinfo" ["my file.pdf"])
["my file.pdf"]

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

{- | A command line as it would be written in a POSIX shell.

>>> displayCommandLine (CommandLine "pdfinfo" ["my file.pdf", "-box"])
"pdfinfo 'my file.pdf' -box"

@since 0.1.0.0
-}
displayCommandLine :: CommandLine -> String
displayCommandLine c =
  unwords (fmap shellQuote (view (cloneLens commandLineProgram) c : view (cloneLens commandLineArguments) c))

{- | Quote a word for a POSIX shell, if it needs quoting.

>>> shellQuote "public/report.pdf"
"public/report.pdf"

>>> shellQuote "it's"
"'it'\\''s'"

>>> shellQuote ""
"''"

@since 0.1.0.0
-}
shellQuote :: String -> String
shellQuote s =
  let safe c = c `elem` ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_./=:,+%@" :: String)
      quote c = if c == '\'' then "'\\''" else [c]
   in if not (null s) && all safe s
        then s
        else "'" <> concatMap quote s <> "'"

{- | The class of 'CommandLine'.

@since 0.2.0.0
-}
class CommandLineLike p f x x' where
  commandLine ::
    Optic p f x x' CommandLine CommandLine

{- | Identity

@since 0.2.0.0
-}
instance (x' ~ CommandLine) => CommandLineLike p f CommandLine x' where
  commandLine =
    id
  {-# INLINE commandLine #-}

{- | Lens

@since 0.2.0.0
-}
instance (p ~ (->), Functor f, x' ~ CommandLine) => CommandLineProgramLike p f CommandLine x' where
  commandLineProgram f (CommandLine p as) =
    fmap (`CommandLine` as) (f p)
  {-# INLINE commandLineProgram #-}

{- | Lens

@since 0.2.0.0
-}
instance (p ~ (->), Functor f, x' ~ CommandLine) => CommandLineArgumentsLike p f CommandLine x' where
  commandLineArguments f (CommandLine p as) =
    fmap (CommandLine p) (f as)
  {-# INLINE commandLineArguments #-}

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

Laws:

> lawNamesCommandLine == id

@since 0.2.0.0
-}
lawNamesCommandLine :: CommandLine -> CommandLine
lawNamesCommandLine s =
  CommandLine (view (cloneLens commandLineProgram) s) (view (cloneLens commandLineArguments) s)

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

@since 0.2.0.0
-}
type InheritCommandLine s =
  ( CommandLineLike (->) (Const ()) s s
  , CommandLineProgramLike (->) (Const ()) s s
  , CommandLineArgumentsLike (->) (Const ()) s s
  )

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

@since 0.2.0.0
-}
inheritCommandLine :: (InheritCommandLine s) => proxy s -> ()
inheritCommandLine _ =
  ()