SVG

SVG.hs

{-# LANGUAGE ExistentialQuantification, GADTs #-}
module Main where


class SvgNode a where
  toSVG :: a -> String
  
data SvgNodeObject where
  Pack :: SvgNode a => a -> SvgNodeObject
  
type Point = (Int,Int)

data Circle = Circle Point Int

instance SvgNode Circle where
  toSVG (Circle (x,y) radius) = "<circle cx='" ++ show x ++ "' cy='" ++ show y ++ "' r='" ++ show radius ++ "' stroke='red' fill='transparent' stroke-width='5'/>"


data Rectangle = Rectangle Point Int Int

instance SvgNode Rectangle where
  toSVG (Rectangle (x,y) width height) = "<rect x='" ++ show x ++ "' y='" ++ show y ++ "' width='" ++ show width ++ "' height='" ++ show height ++ "' stroke='black' fill='transparent' stroke-width='5'/>"
  
svg :: String -> String
svg elems = "<?xml version='1.0' standalone='no'?><svg width='200' height='250' version='1.1' xmlns='http://www.w3.org/2000/svg'>" ++ elems ++ "</svg>"

svgList :: [SvgNodeObject] -> String
svgList nodes = unlines (map (\(Pack a) -> toSVG a) nodes) 

sampleList ::  [SvgNodeObject]
sampleList = [Pack $ Circle (20,30) 50, Pack $ Rectangle (100,100) 30 60]

main :: IO ()
main = writeFile "file.svg" (svg $ svgList sampleList)