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 ((<$>))
import Data.Char (toLower)
import Data.Default.Class (Default(def))
import Data.List (lookup, elem)
import Data.Maybe (fromMaybe)
import Data.Tuple (swap)
import System.FilePath (takeExtensions)
data OutputFormat
= SVG
| SCAD
| PNG
| GCode
| ASCIISTL
| STL
| THREEJS
| OBJ
| DXF
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
def2D :: OutputFormat
def2D :: OutputFormat
def2D = OutputFormat
SVG
def3D :: OutputFormat
def3D :: OutputFormat
def3D = OutputFormat
forall a. Default a => a
def
formats2D :: [OutputFormat]
formats2D :: [OutputFormat]
formats2D = [OutputFormat
GCode, OutputFormat
DXF, OutputFormat
PNG, OutputFormat
SCAD, OutputFormat
SVG]
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
formats3D :: [OutputFormat]
formats3D :: [OutputFormat]
formats3D = [OutputFormat
ASCIISTL, OutputFormat
OBJ, OutputFormat
STL, OutputFormat
SCAD, OutputFormat
THREEJS]
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
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)
]
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
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
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 [] = []
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
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)