{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014 2015, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

module Graphics.Implicit.Export.OutputFormat
  ( OutputFormat (SVG, SCAD, PNG, GCode, ASCIISTL, STL, THREEJS, OBJ, DXF),
    guessOutputFormat,
    formatExtensions,
    formatExtension,
    formats2D,
    formatIs2D,
    def2D,
    formats3D,
    formatIs3D,
    def3D,
  )
where

import Prelude (Bool, Eq, FilePath, Maybe, Read (readsPrec), Show(show), String, drop, error, flip, length, tail, take, ($), (<>), (==))
import Control.Applicative ((<$>))
-- For making the format guesser case insensitive when looking at file extensions.
import Data.Char (toLower)
import Data.Default.Class (Default(def))
import Data.List (lookup, elem)
import Data.Maybe (fromMaybe)
import Data.Tuple (swap)
-- For handling input/output files.
import System.FilePath (takeExtensions)

-- | A type serving to enumerate our output formats.
data OutputFormat
  = SVG
  | SCAD
  | PNG
  | GCode
  | ASCIISTL
  | STL
  | THREEJS
  | OBJ
  | DXF
--  | 3MF
  deriving (Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OutputFormat] -> ShowS
$cshowList :: [OutputFormat] -> ShowS
show :: OutputFormat -> [Char]
$cshow :: OutputFormat -> [Char]
showsPrec :: Int -> OutputFormat -> ShowS
$cshowsPrec :: Int -> OutputFormat -> ShowS
Show, OutputFormat -> OutputFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c== :: OutputFormat -> OutputFormat -> Bool
Eq)

instance Default OutputFormat where
  def :: OutputFormat
def = OutputFormat
STL

-- | Default 2D output format
def2D :: OutputFormat
def2D :: OutputFormat
def2D = OutputFormat
SVG

-- | Default 3D output format
def3D :: OutputFormat
def3D :: OutputFormat
def3D = forall a. Default a => a
def

-- | All supported 2D formats
formats2D :: [OutputFormat]
formats2D :: [OutputFormat]
formats2D = [OutputFormat
GCode, OutputFormat
DXF, OutputFormat
PNG, OutputFormat
SCAD, OutputFormat
SVG]

-- | True for 2D capable `OutputFormat`s
formatIs2D :: OutputFormat -> Bool
formatIs2D :: OutputFormat -> Bool
formatIs2D  = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [OutputFormat]
formats2D

-- | All supported 3D formats
formats3D :: [OutputFormat]
formats3D :: [OutputFormat]
formats3D = [OutputFormat
ASCIISTL, OutputFormat
OBJ, OutputFormat
STL, OutputFormat
SCAD, OutputFormat
THREEJS]

-- | True for 3D capable `OutputFormat`s
formatIs3D :: OutputFormat -> Bool
formatIs3D :: OutputFormat -> Bool
formatIs3D = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [OutputFormat]
formats3D

-- | A list mapping file extensions to output formats.
formatExtensions :: [(String, OutputFormat)]
formatExtensions :: [([Char], OutputFormat)]
formatExtensions =
  [ ([Char]
"svg", OutputFormat
SVG),
    ([Char]
"scad", OutputFormat
SCAD),
    ([Char]
"png", OutputFormat
PNG),
    ([Char]
"ngc", OutputFormat
GCode),
    ([Char]
"gcode", OutputFormat
GCode),
    ([Char]
"ascii.stl", OutputFormat
ASCIISTL),
    ([Char]
"asciistl", OutputFormat
ASCIISTL),
    ([Char]
"stl", OutputFormat
STL),
    ([Char]
"three.js", OutputFormat
THREEJS),
    ([Char]
"threejs", OutputFormat
THREEJS),
    ([Char]
"obj", OutputFormat
OBJ),
    ([Char]
"dxf", OutputFormat
DXF)
--  ("3mf", 3MF)
  ]

-- | Lookup an output format for a given output file. Throw an error if one cannot be found.
guessOutputFormat :: FilePath -> OutputFormat
guessOutputFormat :: [Char] -> OutputFormat
guessOutputFormat [Char]
fileName =
  forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unrecognized output format: " forall a. Semigroup a => a -> a -> a
<> [Char]
ext) forall a b. (a -> b) -> a -> b
$
    [Char] -> Maybe OutputFormat
readOutputFormat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [Char]
ext
  where
    ext :: [Char]
ext = ShowS
takeExtensions [Char]
fileName

-- | Try to look up an output format from a supplied extension.
readOutputFormat :: String -> Maybe OutputFormat
readOutputFormat :: [Char] -> Maybe OutputFormat
readOutputFormat [Char]
ext = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
ext) [([Char], OutputFormat)]
formatExtensions

-- | A Read instance for our output format. Used by 'auto' in our command line parser.
--   Reads a string, and evaluates to the appropriate OutputFormat.
instance Read OutputFormat where
  readsPrec :: Int -> ReadS OutputFormat
readsPrec Int
_ [Char]
myvalue =
    [([Char], OutputFormat)] -> [(OutputFormat, [Char])]
tryParse [([Char], OutputFormat)]
formatExtensions
    where
      tryParse :: [(String, OutputFormat)] -> [(OutputFormat, String)]
      tryParse :: [([Char], OutputFormat)] -> [(OutputFormat, [Char])]
tryParse [] = [] -- If there is nothing left to try, fail
      tryParse (([Char]
attempt, OutputFormat
result) : [([Char], OutputFormat)]
xs) =
        if forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
attempt) [Char]
myvalue forall a. Eq a => a -> a -> Bool
== [Char]
attempt
          then [(OutputFormat
result, forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
attempt) [Char]
myvalue)]
          else [([Char], OutputFormat)] -> [(OutputFormat, [Char])]
tryParse [([Char], OutputFormat)]
xs

-- | Get filename extension for `OutputFormat`
formatExtension :: OutputFormat -> String
formatExtension :: OutputFormat -> [Char]
formatExtension OutputFormat
fmt = forall a. a -> Maybe a -> a
fromMaybe
  (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"No extension defined for OutputFormat " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show OutputFormat
fmt)
  forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup OutputFormat
fmt (forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], OutputFormat)]
formatExtensions)