{-# 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(..)
    , cls
    , extension
    , toolkits
    , inclusionKeys
    , Executable(..)
    , exeFromPath
    -- Utilities

    , isWindows
) where

import           Data.Char              (toLower)
import           Data.List              (intersperse)
import           Data.String            (IsString (..))
import           Data.Text              (Text, pack)
import           Data.Yaml

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

import           Text.Pandoc.Definition (Attr)

-- | List of supported toolkits.

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
    | Bokeh
    | Plotsjl
    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, Eq Toolkit
Eq Toolkit
-> (Toolkit -> Toolkit -> Ordering)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Toolkit)
-> (Toolkit -> Toolkit -> Toolkit)
-> Ord Toolkit
Toolkit -> Toolkit -> Bool
Toolkit -> Toolkit -> Ordering
Toolkit -> Toolkit -> Toolkit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Toolkit -> Toolkit -> Toolkit
$cmin :: Toolkit -> Toolkit -> Toolkit
max :: Toolkit -> Toolkit -> Toolkit
$cmax :: Toolkit -> Toolkit -> Toolkit
>= :: Toolkit -> Toolkit -> Bool
$c>= :: Toolkit -> Toolkit -> Bool
> :: Toolkit -> Toolkit -> Bool
$c> :: Toolkit -> Toolkit -> Bool
<= :: Toolkit -> Toolkit -> Bool
$c<= :: Toolkit -> Toolkit -> Bool
< :: Toolkit -> Toolkit -> Bool
$c< :: Toolkit -> Toolkit -> Bool
compare :: Toolkit -> Toolkit -> Ordering
$ccompare :: Toolkit -> Toolkit -> Ordering
$cp1Ord :: Eq Toolkit
Ord)


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

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


-- | Class name which will trigger the filter

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


-- | Executable program and directory where it can be found.

data Executable = Executable FilePath Text


exeFromPath :: FilePath -> Executable
exeFromPath :: String -> Executable
exeFromPath String
fp = let (String
dir, String
name) = String -> (String, String)
splitFileName String
fp
                 in String -> Text -> Executable
Executable String
dir (String -> Text
pack String
name)


-- | Source context for plotting scripts

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
(<>) CheckResult
CheckPassed CheckResult
a                         = CheckResult
a
    (<>) CheckResult
a CheckResult
CheckPassed                         = CheckResult
a
    (<>) (CheckFailed Text
msg1) (CheckFailed 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
    | DependenciesK
    | FileK
    | 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 InclusionKey
DirectoryK             = String
"directory"
    show InclusionKey
CaptionK               = String
"caption"
    show InclusionKey
SaveFormatK            = String
"format"
    show InclusionKey
WithSourceK            = String
"source"
    show InclusionKey
CaptionFormatK         = String
"caption_format"
    show InclusionKey
PreambleK              = String
"preamble"
    show InclusionKey
DpiK                   = String
"dpi"
    show InclusionKey
ExecutableK            = String
"executable"
    show InclusionKey
DependenciesK          = String
"dependencies"
    show InclusionKey
FileK                  = String
"file"
    show InclusionKey
MatplotlibTightBBoxK   = String
"tight_bbox"
    show InclusionKey
MatplotlibTransparentK = String
"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 -> [String]
dependencies :: ![FilePath]     -- ^ Files/directories on which this figure depends, e.g. data files.

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

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

    }


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

    | HTML  -- ^ HTML for interactive plots.

    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 String
s
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"png", String
"PNG", String
".png"] = SaveFormat
PNG
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"pdf", String
"PDF", String
".pdf"] = SaveFormat
PDF
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"svg", String
"SVG", String
".svg"] = SaveFormat
SVG
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"eps", String
"EPS", String
".eps"] = SaveFormat
EPS
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"gif", String
"GIF", String
".gif"] = SaveFormat
GIF
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"jpg", String
"jpeg", String
"JPG", String
"JPEG", String
".jpg", String
".jpeg"] = SaveFormat
JPG
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"tif", String
"tiff", String
"TIF", String
"TIFF", String
".tif", String
".tiff"] = SaveFormat
TIF
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"webp", String
"WEBP", String
".webp"] = SaveFormat
WEBP
        | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"html", String
"HTML", String
".html"] = SaveFormat
HTML
        | Bool
otherwise = String -> SaveFormat
forall a. String -> a
errorWithoutStackTrace (String -> SaveFormat) -> String -> SaveFormat
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
s
                        , String
" 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] -> [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 SaveFormat
fmt = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
".", (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` [String
"mingw32", String
"win32", String
"cygwin32"] -- Aliases taken from cabal's Distribution.System module