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 -> [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
def2D :: OutputFormat
def2D :: OutputFormat
def2D = OutputFormat
SVG
def3D :: OutputFormat
def3D :: OutputFormat
def3D = 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 = 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
formats3D :: [OutputFormat]
formats3D :: [OutputFormat]
formats3D = [OutputFormat
ASCIISTL, OutputFormat
OBJ, OutputFormat
STL, OutputFormat
SCAD, OutputFormat
THREEJS]
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
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)
]
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
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
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 [] = []
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
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)