{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}


{-|
Module      : $header$
Copyright   : (c) Laurent P René de Cotret, 2020
License     : GNU GPL, version 2 or above
Maintainer  : laurent.decotret@outlook.com
Stability   : internal
Portability : portable

This module defines base types in use in pandoc-plot
-}

module Text.Pandoc.Filter.Plot.Monad.Types (
      Toolkit(..)
    , Script
    , CheckResult(..)
    , InclusionKey(..)
    , FigureSpec(..)
    , SaveFormat(..)
    , figureContentHash
    , cls
    , extension
    , toolkits
    , inclusionKeys
    -- Utilities

    , isWindows
) where

import           Data.Char              (toLower)
import           Data.Hashable          (hash)
import           Data.List              (intersperse)
import           Data.Semigroup         (Semigroup (..))
import           Data.String            (IsString (..))
import           Data.Text              (Text)
import           Data.Yaml

import           GHC.Generics           (Generic)
import           System.Info            (os)

import           Text.Pandoc.Definition (Attr)


toolkits :: [Toolkit]
toolkits :: [Toolkit]
toolkits = Toolkit -> Toolkit -> [Toolkit]
forall a. Enum a => a -> a -> [a]
enumFromTo Toolkit
forall a. Bounded a => a
minBound Toolkit
forall a. Bounded a => a
maxBound


-- | Enumeration of supported toolkits

data Toolkit
    = Matplotlib
    | Matlab
    | PlotlyPython
    | PlotlyR
    | Mathematica
    | Octave
    | GGPlot2
    | GNUPlot
    | Graphviz
    deriving (Toolkit
Toolkit -> Toolkit -> Bounded Toolkit
forall a. a -> a -> Bounded a
maxBound :: Toolkit
$cmaxBound :: Toolkit
minBound :: Toolkit
$cminBound :: Toolkit
Bounded, Toolkit -> Toolkit -> Bool
(Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool) -> Eq Toolkit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Toolkit -> Toolkit -> Bool
$c/= :: Toolkit -> Toolkit -> Bool
== :: Toolkit -> Toolkit -> Bool
$c== :: Toolkit -> Toolkit -> Bool
Eq, Int -> Toolkit
Toolkit -> Int
Toolkit -> [Toolkit]
Toolkit -> Toolkit
Toolkit -> Toolkit -> [Toolkit]
Toolkit -> Toolkit -> Toolkit -> [Toolkit]
(Toolkit -> Toolkit)
-> (Toolkit -> Toolkit)
-> (Int -> Toolkit)
-> (Toolkit -> Int)
-> (Toolkit -> [Toolkit])
-> (Toolkit -> Toolkit -> [Toolkit])
-> (Toolkit -> Toolkit -> [Toolkit])
-> (Toolkit -> Toolkit -> Toolkit -> [Toolkit])
-> Enum Toolkit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Toolkit -> Toolkit -> Toolkit -> [Toolkit]
$cenumFromThenTo :: Toolkit -> Toolkit -> Toolkit -> [Toolkit]
enumFromTo :: Toolkit -> Toolkit -> [Toolkit]
$cenumFromTo :: Toolkit -> Toolkit -> [Toolkit]
enumFromThen :: Toolkit -> Toolkit -> [Toolkit]
$cenumFromThen :: Toolkit -> Toolkit -> [Toolkit]
enumFrom :: Toolkit -> [Toolkit]
$cenumFrom :: Toolkit -> [Toolkit]
fromEnum :: Toolkit -> Int
$cfromEnum :: Toolkit -> Int
toEnum :: Int -> Toolkit
$ctoEnum :: Int -> Toolkit
pred :: Toolkit -> Toolkit
$cpred :: Toolkit -> Toolkit
succ :: Toolkit -> Toolkit
$csucc :: Toolkit -> Toolkit
Enum, (forall x. Toolkit -> Rep Toolkit x)
-> (forall x. Rep Toolkit x -> Toolkit) -> Generic Toolkit
forall x. Rep Toolkit x -> Toolkit
forall x. Toolkit -> Rep Toolkit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Toolkit x -> Toolkit
$cfrom :: forall x. Toolkit -> Rep Toolkit x
Generic)


-- | This instance should only be used to display toolkit names

instance Show Toolkit where
    show :: Toolkit -> String
show Matplotlib   = "Python/Matplotlib"
    show Matlab       = "MATLAB"
    show PlotlyPython = "Python/Plotly"
    show PlotlyR      = "R/Plotly"
    show Mathematica  = "Mathematica"
    show Octave       = "GNU Octave"
    show GGPlot2      = "ggplot2"
    show GNUPlot      = "gnuplot"
    show Graphviz     = "graphviz"


-- | Class name which will trigger the filter

cls :: Toolkit -> Text
cls :: Toolkit -> Text
cls Matplotlib   = "matplotlib"
cls Matlab       = "matlabplot"
cls PlotlyPython = "plotly_python"
cls PlotlyR      = "plotly_r"
cls Mathematica  = "mathplot"
cls Octave       = "octaveplot"
cls GGPlot2      = "ggplot2"
cls GNUPlot      = "gnuplot"
cls Graphviz     = "graphviz"


type Script = Text


-- | Result of checking scripts for problems

data CheckResult
    = CheckPassed
    | CheckFailed Text
    deriving (CheckResult -> CheckResult -> Bool
(CheckResult -> CheckResult -> Bool)
-> (CheckResult -> CheckResult -> Bool) -> Eq CheckResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckResult -> CheckResult -> Bool
$c/= :: CheckResult -> CheckResult -> Bool
== :: CheckResult -> CheckResult -> Bool
$c== :: CheckResult -> CheckResult -> Bool
Eq)

instance Semigroup CheckResult where
    <> :: CheckResult -> CheckResult -> CheckResult
(<>) CheckPassed a :: CheckResult
a                         = CheckResult
a
    (<>) a :: CheckResult
a CheckPassed                         = CheckResult
a
    (<>) (CheckFailed msg1 :: Text
msg1) (CheckFailed msg2 :: Text
msg2) = Text -> CheckResult
CheckFailed (Text
msg1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg2)

instance Monoid CheckResult where
    mempty :: CheckResult
mempty = CheckResult
CheckPassed


-- | Description of any possible inclusion key, both in documents

-- and in configuration files.

data InclusionKey
    = DirectoryK
    | CaptionK
    | SaveFormatK
    | WithSourceK
    | CaptionFormatK
    | PreambleK
    | DpiK
    | ExecutableK
    | MatplotlibTightBBoxK
    | MatplotlibTransparentK
    deriving (InclusionKey
InclusionKey -> InclusionKey -> Bounded InclusionKey
forall a. a -> a -> Bounded a
maxBound :: InclusionKey
$cmaxBound :: InclusionKey
minBound :: InclusionKey
$cminBound :: InclusionKey
Bounded, InclusionKey -> InclusionKey -> Bool
(InclusionKey -> InclusionKey -> Bool)
-> (InclusionKey -> InclusionKey -> Bool) -> Eq InclusionKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InclusionKey -> InclusionKey -> Bool
$c/= :: InclusionKey -> InclusionKey -> Bool
== :: InclusionKey -> InclusionKey -> Bool
$c== :: InclusionKey -> InclusionKey -> Bool
Eq, Int -> InclusionKey
InclusionKey -> Int
InclusionKey -> [InclusionKey]
InclusionKey -> InclusionKey
InclusionKey -> InclusionKey -> [InclusionKey]
InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey]
(InclusionKey -> InclusionKey)
-> (InclusionKey -> InclusionKey)
-> (Int -> InclusionKey)
-> (InclusionKey -> Int)
-> (InclusionKey -> [InclusionKey])
-> (InclusionKey -> InclusionKey -> [InclusionKey])
-> (InclusionKey -> InclusionKey -> [InclusionKey])
-> (InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey])
-> Enum InclusionKey
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey]
$cenumFromThenTo :: InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey]
enumFromTo :: InclusionKey -> InclusionKey -> [InclusionKey]
$cenumFromTo :: InclusionKey -> InclusionKey -> [InclusionKey]
enumFromThen :: InclusionKey -> InclusionKey -> [InclusionKey]
$cenumFromThen :: InclusionKey -> InclusionKey -> [InclusionKey]
enumFrom :: InclusionKey -> [InclusionKey]
$cenumFrom :: InclusionKey -> [InclusionKey]
fromEnum :: InclusionKey -> Int
$cfromEnum :: InclusionKey -> Int
toEnum :: Int -> InclusionKey
$ctoEnum :: Int -> InclusionKey
pred :: InclusionKey -> InclusionKey
$cpred :: InclusionKey -> InclusionKey
succ :: InclusionKey -> InclusionKey
$csucc :: InclusionKey -> InclusionKey
Enum)

-- | Keys that pandoc-plot will look for in code blocks.

-- These are only exported for testing purposes.

instance Show InclusionKey where
    show :: InclusionKey -> String
show DirectoryK             = "directory"
    show CaptionK               = "caption"
    show SaveFormatK            = "format"
    show WithSourceK            = "source"
    show CaptionFormatK         = "caption_format"
    show PreambleK              = "preamble"
    show DpiK                   = "dpi"
    show ExecutableK            = "executable"
    show MatplotlibTightBBoxK   = "tight_bbox"
    show MatplotlibTransparentK = "transparent"


-- | List of all keys related to pandoc-plot that

-- can be specified in source material.

inclusionKeys :: [InclusionKey]
inclusionKeys :: [InclusionKey]
inclusionKeys = InclusionKey -> InclusionKey -> [InclusionKey]
forall a. Enum a => a -> a -> [a]
enumFromTo (InclusionKey
forall a. Bounded a => a
minBound::InclusionKey) InclusionKey
forall a. Bounded a => a
maxBound


-- | Datatype containing all parameters required to run pandoc-plot.

--

-- It is assumed that once a @FigureSpec@ has been created, no configuration

-- can overload it; hence, a @FigureSpec@ completely encodes a particular figure.

data FigureSpec = FigureSpec
    { FigureSpec -> Toolkit
toolkit    :: !Toolkit        -- ^ Plotting toolkit to use for this figure.

    , FigureSpec -> Text
caption    :: !Text           -- ^ Figure caption.

    , FigureSpec -> Bool
withSource :: !Bool           -- ^ Append link to source code in caption.

    , FigureSpec -> Text
script     :: !Script         -- ^ Source code for the figure.

    , FigureSpec -> SaveFormat
saveFormat :: !SaveFormat     -- ^ Save format of the figure.

    , FigureSpec -> String
directory  :: !FilePath       -- ^ Directory where to save the file.

    , FigureSpec -> Int
dpi        :: !Int            -- ^ Dots-per-inch of figure.

    , FigureSpec -> [(Text, Text)]
extraAttrs :: ![(Text, Text)] -- ^ Renderer-specific extra attributes.

    , FigureSpec -> Attr
blockAttrs :: !Attr           -- ^ Attributes not related to @pandoc-plot@ will be propagated.

    }


-- | Hash of the content of a @FigureSpec@. Note that unlike usual hashes,

-- two @FigureSpec@ with the same @figureContentHash@ does not mean that they are equal!

--

-- Not all parts of a FigureSpec are related to running code.

-- For example, changing the caption should not require running the figure again.

figureContentHash :: FigureSpec -> Int
figureContentHash :: FigureSpec -> Int
figureContentHash FigureSpec{..} = 
    (Int, Text, Int, String, Int, [(Text, Text)]) -> Int
forall a. Hashable a => a -> Int
hash (Toolkit -> Int
forall a. Enum a => a -> Int
fromEnum Toolkit
toolkit, Text
script, SaveFormat -> Int
forall a. Enum a => a -> Int
fromEnum SaveFormat
saveFormat, String
directory, Int
dpi, [(Text, Text)]
extraAttrs)


-- | Generated figure file format supported by pandoc-plot.

-- Note that not all formats are supported by all toolkits.

data SaveFormat
    = PNG   -- ^ Portable network graphics

    | PDF   -- ^ Portable document format

    | SVG   -- ^ Scalable vector graphics

    | JPG   -- ^ JPEG/JPG compressed image

    | EPS   -- ^ Encapsulated postscript

    | GIF   -- ^ GIF format

    | TIF   -- ^ Tagged image format

    | WEBP  -- ^ WebP image format

    deriving (SaveFormat
SaveFormat -> SaveFormat -> Bounded SaveFormat
forall a. a -> a -> Bounded a
maxBound :: SaveFormat
$cmaxBound :: SaveFormat
minBound :: SaveFormat
$cminBound :: SaveFormat
Bounded, Int -> SaveFormat
SaveFormat -> Int
SaveFormat -> [SaveFormat]
SaveFormat -> SaveFormat
SaveFormat -> SaveFormat -> [SaveFormat]
SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat]
(SaveFormat -> SaveFormat)
-> (SaveFormat -> SaveFormat)
-> (Int -> SaveFormat)
-> (SaveFormat -> Int)
-> (SaveFormat -> [SaveFormat])
-> (SaveFormat -> SaveFormat -> [SaveFormat])
-> (SaveFormat -> SaveFormat -> [SaveFormat])
-> (SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat])
-> Enum SaveFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat]
$cenumFromThenTo :: SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat]
enumFromTo :: SaveFormat -> SaveFormat -> [SaveFormat]
$cenumFromTo :: SaveFormat -> SaveFormat -> [SaveFormat]
enumFromThen :: SaveFormat -> SaveFormat -> [SaveFormat]
$cenumFromThen :: SaveFormat -> SaveFormat -> [SaveFormat]
enumFrom :: SaveFormat -> [SaveFormat]
$cenumFrom :: SaveFormat -> [SaveFormat]
fromEnum :: SaveFormat -> Int
$cfromEnum :: SaveFormat -> Int
toEnum :: Int -> SaveFormat
$ctoEnum :: Int -> SaveFormat
pred :: SaveFormat -> SaveFormat
$cpred :: SaveFormat -> SaveFormat
succ :: SaveFormat -> SaveFormat
$csucc :: SaveFormat -> SaveFormat
Enum, SaveFormat -> SaveFormat -> Bool
(SaveFormat -> SaveFormat -> Bool)
-> (SaveFormat -> SaveFormat -> Bool) -> Eq SaveFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaveFormat -> SaveFormat -> Bool
$c/= :: SaveFormat -> SaveFormat -> Bool
== :: SaveFormat -> SaveFormat -> Bool
$c== :: SaveFormat -> SaveFormat -> Bool
Eq, Int -> SaveFormat -> ShowS
[SaveFormat] -> ShowS
SaveFormat -> String
(Int -> SaveFormat -> ShowS)
-> (SaveFormat -> String)
-> ([SaveFormat] -> ShowS)
-> Show SaveFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaveFormat] -> ShowS
$cshowList :: [SaveFormat] -> ShowS
show :: SaveFormat -> String
$cshow :: SaveFormat -> String
showsPrec :: Int -> SaveFormat -> ShowS
$cshowsPrec :: Int -> SaveFormat -> ShowS
Show, (forall x. SaveFormat -> Rep SaveFormat x)
-> (forall x. Rep SaveFormat x -> SaveFormat) -> Generic SaveFormat
forall x. Rep SaveFormat x -> SaveFormat
forall x. SaveFormat -> Rep SaveFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SaveFormat x -> SaveFormat
$cfrom :: forall x. SaveFormat -> Rep SaveFormat x
Generic)

instance IsString SaveFormat where
    -- | An error is thrown if the save format cannot be parsed. That's OK

    -- since pandoc-plot is a command-line tool and isn't expected to run

    -- long.

    fromString :: String -> SaveFormat
fromString s :: String
s
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["png", "PNG", ".png"] = SaveFormat
PNG
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["pdf", "PDF", ".pdf"] = SaveFormat
PDF
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["svg", "SVG", ".svg"] = SaveFormat
SVG
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["eps", "EPS", ".eps"] = SaveFormat
EPS
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["gif", "GIF", ".gif"] = SaveFormat
GIF
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["jpg", "jpeg", "JPG", "JPEG", ".jpg", ".jpeg"] = SaveFormat
JPG
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["tif", "tiff", "TIF", "TIFF", ".tif", ".tiff"] = SaveFormat
TIF
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["webp", "WEBP", ".webp"] = SaveFormat
WEBP
        | Bool
otherwise = String -> SaveFormat
forall a. HasCallStack => String -> a
error (String -> SaveFormat) -> String -> SaveFormat
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
s
                        , " is not one of valid save format : "
                        , [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ SaveFormat -> String
forall a. Show a => a -> String
show (SaveFormat -> String) -> [SaveFormat] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SaveFormat]
saveFormats
                        ]
        where
            saveFormats :: [SaveFormat]
saveFormats =  (SaveFormat -> SaveFormat -> [SaveFormat]
forall a. Enum a => a -> a -> [a]
enumFromTo SaveFormat
forall a. Bounded a => a
minBound SaveFormat
forall a. Bounded a => a
maxBound) :: [SaveFormat]

instance FromJSON SaveFormat -- TODO: test this parsing


instance ToJSON SaveFormat where
    toJSON :: SaveFormat -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (SaveFormat -> String) -> SaveFormat -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaveFormat -> String
extension


-- | Save format file extension

extension :: SaveFormat -> String
extension :: SaveFormat -> String
extension fmt :: SaveFormat
fmt = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [".", (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> (SaveFormat -> String) -> SaveFormat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaveFormat -> String
forall a. Show a => a -> String
show (SaveFormat -> String) -> SaveFormat -> String
forall a b. (a -> b) -> a -> b
$ SaveFormat
fmt]


isWindows :: Bool
isWindows :: Bool
isWindows = String
os String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["mingw32", "win32", "cygwin32"] -- Aliases taken from cabal's Distribution.System module