{- 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 -> String
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputFormat] -> ShowS
$cshowList :: [OutputFormat] -> ShowS
show :: OutputFormat -> String
$cshow :: OutputFormat -> String
showsPrec :: Int -> OutputFormat -> ShowS
$cshowsPrec :: Int -> OutputFormat -> ShowS
Show, OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
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 = OutputFormat
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  = (OutputFormat -> [OutputFormat] -> Bool)
-> [OutputFormat] -> OutputFormat -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip OutputFormat -> [OutputFormat] -> Bool
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 = (OutputFormat -> [OutputFormat] -> Bool)
-> [OutputFormat] -> OutputFormat -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip OutputFormat -> [OutputFormat] -> Bool
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 :: [(String, OutputFormat)]
formatExtensions =
  [ (String
"svg", OutputFormat
SVG),
    (String
"scad", OutputFormat
SCAD),
    (String
"png", OutputFormat
PNG),
    (String
"ngc", OutputFormat
GCode),
    (String
"gcode", OutputFormat
GCode),
    (String
"ascii.stl", OutputFormat
ASCIISTL),
    (String
"asciistl", OutputFormat
ASCIISTL),
    (String
"stl", OutputFormat
STL),
    (String
"three.js", OutputFormat
THREEJS),
    (String
"threejs", OutputFormat
THREEJS),
    (String
"obj", OutputFormat
OBJ),
    (String
"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 :: String -> OutputFormat
guessOutputFormat String
fileName =
  OutputFormat -> Maybe OutputFormat -> OutputFormat
forall a. a -> Maybe a -> a
fromMaybe (String -> OutputFormat
forall a. HasCallStack => String -> a
error (String -> OutputFormat) -> String -> OutputFormat
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized output format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ext) (Maybe OutputFormat -> OutputFormat)
-> Maybe OutputFormat -> OutputFormat
forall a b. (a -> b) -> a -> b
$
    String -> Maybe OutputFormat
readOutputFormat (String -> Maybe OutputFormat) -> String -> Maybe OutputFormat
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
tail String
ext
  where
    ext :: String
ext = ShowS
takeExtensions String
fileName

-- | Try to look up an output format from a supplied extension.
readOutputFormat :: String -> Maybe OutputFormat
readOutputFormat :: String -> Maybe OutputFormat
readOutputFormat String
ext = String -> [(String, OutputFormat)] -> Maybe OutputFormat
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
ext) [(String, 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
_ String
myvalue =
    [(String, OutputFormat)] -> [(OutputFormat, String)]
tryParse [(String, OutputFormat)]
formatExtensions
    where
      tryParse :: [(String, OutputFormat)] -> [(OutputFormat, String)]
      tryParse :: [(String, OutputFormat)] -> [(OutputFormat, String)]
tryParse [] = [] -- If there is nothing left to try, fail
      tryParse ((String
attempt, OutputFormat
result) : [(String, OutputFormat)]
xs) =
        if Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
attempt) String
myvalue String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
attempt
          then [(OutputFormat
result, Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
attempt) String
myvalue)]
          else [(String, OutputFormat)] -> [(OutputFormat, String)]
tryParse [(String, OutputFormat)]
xs

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