separate tiled modules out into own package

1 files changed, 0 insertions, 395 deletions

diff --git a/lib/Tiled.hs b/lib/Tiled.hs
deleted file mode 100644
index 3162dfd..0000000
--- a/lib/Tiled.hs
+++ /dev/null
@@ -1,395 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes        #-}
-{-# LANGUAGE DeriveAnyClass             #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE DerivingStrategies         #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE NamedFieldPuns             #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-
--- | This module provides Haskell types for Tiled's JSON exports, which you can
--- read about at http://doc.mapeditor.org/en/latest/reference/json-map-format/.
--- That said - as of the writing of this module the JSON documentation does not
--- cover some of the types and records that are available in the format. For
--- those you should read the TMX documentation at
--- http://doc.mapeditor.org/en/latest/reference/tmx-map-format/
-module Tiled where
-
-import           Universum
-
--- TODO: what ever are these aeson imports
-import           Data.Aeson           hiding (Object)
-import qualified Data.Aeson           as A
-import           Data.Aeson.Types     (typeMismatch)
-import qualified Data.ByteString      as BS
-import qualified Data.ByteString.Lazy as LB
-import           Data.Char            (toLower)
-
-
--- | options for Aeson's generic encoding and parsing functions
-aesonOptions :: Int -> Options
-aesonOptions l = defaultOptions
-  { omitNothingFields = True
-  , rejectUnknownFields = True
-  -- can't be bothered to do a nicer prefix strip
-  , fieldLabelModifier = drop l . map toLower
-  , sumEncoding = UntaggedValue
-  }
-
--- | A globally indexed identifier.
-newtype GlobalId = GlobalId { unGlobalId :: Int }
-  deriving newtype (Ord, Eq, Enum, Num, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey, NFData)
-
-mkTiledId :: Int -> GlobalId
-mkTiledId i = GlobalId { unGlobalId = i }
-
--- | A locally indexed identifier.
-newtype LocalId = LocalId { unLocalId :: Int }
-  deriving newtype (Ord, Eq, Enum, Num, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey, NFData)
-
-type Color = Text
-
--- | A custom tiled property, which just has a name and a value.
-data Property = Property Text PropertyValue
-  deriving (Eq, Generic, Show, NFData)
-
--- | The value of a custom tiled property.
--- It is strongly typed via a tag in the json representation,
--- and needs a custom ToJSON and FromJSON instance because of that.
-data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int | FloatProp Float
-  deriving (Eq, Generic, Show, NFData)
-
-instance IsString PropertyValue where
-  fromString s = StrProp (toText s)
-
-instance FromJSON Property where
-  parseJSON (A.Object o) = do
-    name <- o .: "name"
-    o .: "type" >>= \case
-      A.String "string" -> do
-        val <- o .: "value"
-        pure $ Property name (StrProp val)
-      A.String "bool" -> do
-        val <- o .: "value"
-        pure $ Property name (BoolProp val)
-      A.String "int" -> do
-        val <- o .: "value"
-        pure $ Property name (IntProp val)
-      A.String "float" -> do
-        val <- o .: "value"
-        pure $ Property name (FloatProp val)
-      ty -> fail $ "properties can only have types string, int, bool, but encountered type" <> show ty
-  parseJSON invalid = typeMismatch "Property" invalid
-
-instance ToJSON Property where
-  toJSON (Property name val) = case val of
-    StrProp str -> object
-      [ "type" .= A.String "string"
-      , "name" .= name
-      , "value" .= str
-      ]
-    BoolProp bool -> object
-      [ "type" .= A.String "bool"
-      , "name" .= name
-      , "value" .= bool
-      ]
-    IntProp int -> object
-      [ "type" .= A.String "int"
-      , "name" .= name
-      , "value" .= int
-      ]
-    FloatProp float -> object
-      [ "type" .= A.String "float"
-      , "name" .= name
-      , "value" .= float
-      ]
-
-data Point = Point { pointX :: Double
-                   , pointY :: Double
-                   } deriving (Eq, Generic, Show, NFData)
-
-instance FromJSON Point where
-  parseJSON = genericParseJSON (aesonOptions 5)
-instance ToJSON Point where
-  toJSON = genericToJSON (aesonOptions 5)
-
-
--- | all kinds of objects that can occur in object layers, even
--- | those that we don't want to allow.
-data Object = ObjectRectangle
-  { objectId         :: Int
-  , objectName       :: Maybe String
-  , objectProperties :: Maybe (Vector Property)
-  , objectVisible    :: Maybe Bool
-  , objectX          :: Double
-  , objectY          :: Double
-  , objectRotation   :: Double
-  , objectGid        :: Maybe GlobalId
-  , objectWidth      :: Maybe Double
-  , objectHeight     :: Maybe Double
-  , objectEllipse    :: Maybe Bool
-  , objectPoint      :: Maybe Bool
-  , objectType       :: Text
-  }
-  | ObjectPolygon
-  { objectId         :: Int
-  , objectName       :: Maybe String
-  , objectProperties :: Maybe (Vector Property)
-  , objectVisible    :: Maybe Bool
-  , objectX          :: Double
-  , objectY          :: Double
-  , objectRotation   :: Double
-  , objectGid        :: Maybe GlobalId
-  , objectWidth      :: Maybe Double
-  , objectHeight     :: Maybe Double
-  , objectType       :: Text
-  , objectPolygon    :: Vector Point
-  }
-  | ObjectPolyline
-  { objectId         :: Int
-  , objectName       :: Maybe String
-  , objectProperties :: Maybe (Vector Property)
-  , objectVisible    :: Maybe Bool
-  , objectX          :: Double
-  , objectY          :: Double
-  , objectRotation   :: Double
-  , objectGid        :: Maybe GlobalId
-  , objectWidth      :: Maybe Double
-  , objectHeight     :: Maybe Double
-  , objectType       :: Text
-  , objectPolyline   :: Vector Point
-  }
-  | ObjectText
-  { objectId         :: Int
-  , objectName       :: Maybe String
-  , objectProperties :: Maybe (Vector Property)
-  , objectVisible    :: Maybe Bool
-  , objectX          :: Double
-  , objectY          :: Double
-  , objectRotation   :: Double
-  , objectGid        :: Maybe GlobalId
-  , objectText       :: A.Value
-  , objectWidth      :: Maybe Double
-  , objectHeight     :: Maybe Double
-  , objectEllipse    :: Maybe Bool
-  , objectType       :: Text
-  } deriving (Eq, Generic, Show, NFData)
-
-
-
-
-
-instance FromJSON Object where
-  parseJSON = genericParseJSON (aesonOptions 6)
-instance ToJSON Object where
-  toJSON = genericToJSON (aesonOptions 6)
-
-
-data Layer = Layer { layerWidth            :: Maybe Double
-                     -- ^ Column count. Same as map width for fixed-size maps.
-                   , layerHeight           :: Maybe Double
-                     -- ^ Row count. Same as map height for fixed-size maps.
-                   , layerName             :: Text
-                     -- ^ Name assigned to this layer
-                   , layerType             :: Text
-                     -- ^ “tilelayer”, “objectgroup”, or “imagelayer”
-                   , layerVisible          :: Bool
-                     -- ^ Whether layer is shown or hidden in editor
-                   , layerX                :: Double
-                     -- ^ Horizontal layer offset in tiles. Always 0.
-                   , layerY                :: Double
-                     -- ^ Vertical layer offset in tiles. Always 0.
-                   , layerData             :: Maybe (Vector GlobalId)
-                     -- ^ Array of GIDs. tilelayer only.
-                   , layerObjects          :: Maybe (Vector Object)
-                     -- ^ Array of Objects. objectgroup only.
-                   , layerProperties       :: Maybe [Property]
-                     -- ^ string key-value pairs.
-                   , layerOpacity          :: Float
-                     -- ^ Value between 0 and 1
-                   , layerDraworder        :: Maybe String
-                     -- ^ “topdown” (default) or “index”. objectgroup only.
-                   , layerId               :: Int
-                   , layerOffsetx          :: Maybe Float
-                   , layerOffsety          :: Maybe Float
-                   , layerParallaxx        :: Maybe Float
-                   , layerParallaxy        :: Maybe Float
-                   , layerTintColor        :: Maybe Color
-                   , layerTransparentColor :: Maybe Color
-                   , layerImage            :: Maybe Text
-                   , layerLayers           :: Maybe [Layer]
-                   , layerStartX           :: Maybe Int
-                   , layerStartY           :: Maybe Int
-                   , layerColor            :: Maybe Color
-                   } deriving (Eq, Generic, Show, NFData)
-
-instance FromJSON Layer where
-  parseJSON = genericParseJSON (aesonOptions 5)
-instance ToJSON Layer where
-  toJSON = genericToJSON (aesonOptions 5)
-
-
-data Terrain = Terrain { terrainName :: String
-                         -- ^ Name of terrain
-                       , terrainTile :: LocalId
-                         -- ^ Local ID of tile representing terrain
-                       } deriving (Eq, Generic, Show, NFData)
-
-instance FromJSON Terrain where
-  parseJSON (A.Object o) = Terrain <$> o .: "name"
-                                   <*> o .: "tile"
-  parseJSON invalid = typeMismatch "Terrain" invalid
-
-instance ToJSON Terrain where
-  toJSON Terrain{..} = object [ "name" .= terrainName
-                              , "tile" .= terrainTile
-                              ]
-
-
-
-data Frame = Frame { frameDuration :: Int
-                   , frameTileId   :: LocalId
-                   } deriving (Eq, Generic, Show, NFData)
-
-instance FromJSON Frame where
-  parseJSON (A.Object o) = Frame <$> o .: "duration"
-                                 <*> o .: "tileid"
-  parseJSON invalid = typeMismatch "Frame" invalid
-
-instance ToJSON Frame where
-  toJSON Frame{..} = object [ "duration" .= frameDuration
-                            , "tileid"   .= frameTileId
-                            ]
-
-
-data Tile = Tile { tileId          :: Int
-                 , tileProperties  :: Maybe (Vector Property)
-                 , tileImage       :: Maybe Value
-                 , tileObjectGroup :: Maybe Value
-                 , tileAnimation   :: Maybe (Vector Frame)
-                 , tileImageheight :: Maybe Int
-                 , tileImagewidth  :: Maybe Int
-                 , tileProbability :: Maybe Float
-                 , tileType        :: Maybe Text
-                 , tileTerrain     :: Maybe [Int]
-                 } deriving (Eq, Generic, Show, NFData)
-
-instance FromJSON Tile where
-  parseJSON = genericParseJSON (aesonOptions 4)
-
-instance ToJSON Tile where
-  toJSON = genericToJSON (aesonOptions 4)
-
-
-
-data Tileset = Tileset { tilesetFirstgid         :: GlobalId
-                         -- ^ GID corresponding to the first tile in the set
-                       , tilesetImage            :: Maybe Text
-                         -- ^ Image used for tiles in this set
-                       , tilesetName             :: Text
-                         -- ^ Name given to this tileset
-                       , tilesetTilewidth        :: Int
-                         -- ^ Maximum width of tiles in this set
-                       , tilesetTileheight       :: Int
-                         -- ^ Maximum height of tiles in this set
-                       , tilesetImagewidth       :: Int
-                         -- ^ Width of source image in pixels
-                       , tilesetImageheight      :: Int
-                         -- ^ Height of source image in pixels
-                       , tilesetProperties       :: Maybe [Property]
-                         -- ^ String key-value pairs
-                       , tilesetPropertytypes    :: Maybe (Map Text Text)
-                         -- ^ String key-value pairs
-                       , tilesetMargin           :: Int
-                         -- ^ Buffer between image edge and first tile (pixels)
-                       , tilesetSpacing          :: Int
-                         -- ^ Spacing between adjacent tiles in image (pixels)
-                       , tilesetTileproperties   :: Maybe (Map GlobalId (Map Text Text))
-                         -- ^ Per-tile properties, indexed by gid as string
-                       , tilesetTerrains         :: Maybe (Vector Terrain)
-                         -- ^ Array of Terrains (optional)
-                       , tilesetColumns          :: Int
-                         -- ^ The number of tile columns in the tileset
-                       , tilesetTilecount        :: Int
-                         -- ^ The number of tiles in this tileset
-                       , tilesetTiles            :: Maybe (Vector Tile)
-                         -- ^ Tiles (optional)
-                       , tilesetTransparentcolor :: Maybe Text
-                       , tilesetEditorsettings   :: Maybe Value
-                       , tilesetBackgroundColor  :: Maybe Text
-                       , tilesetGrid             :: Maybe Value
-                       , tilesetSource           :: Maybe Text
-                       , tilesetTiledversion     :: Maybe Text
-                       , tilesetTileoffset       :: Maybe Value
-                       , tilesetTransformations  :: Maybe Value
-                       , tilesetVersion          :: Maybe Value
-                       , tilesetWangsets         :: Maybe Value
-                       , tilesetType             :: Maybe Text
-                       , tilesetFileName         :: Maybe Text
-                       } deriving (Eq, Generic, Show, NFData)
-
-newtype TransitiveTilesetMap = TransitiveTilesetMap (Map LocalId Value)
-  deriving newtype (Show, Eq, FromJSON)
-
-instance FromJSON Tileset where
-  parseJSON = genericParseJSON (aesonOptions 7)
-
-instance ToJSON Tileset where
-  toJSON = genericToJSON (aesonOptions 7)
-
-
--- | The full monty.
-data Tiledmap = Tiledmap { tiledmapVersion          :: Value
-                           -- ^ The JSON format version
-                         , tiledmapTiledversion     :: Maybe String
-                           -- ^ The Tiled version used to save the file
-                         , tiledmapWidth            :: Int
-                           -- ^ Number of tile columns
-                         , tiledmapHeight           :: Int
-                           -- ^ Number of tile rows
-                         , tiledmapTilewidth        :: Double
-                           -- ^ Map grid width.
-                         , tiledmapTileheight       :: Double
-                           -- ^ Map grid height.
-                         , tiledmapOrientation      :: String
-                           -- ^ Orthogonal, isometric, or staggered
-                         , tiledmapLayers           :: Vector Layer
-                           -- ^ Array of Layers
-                         , tiledmapTilesets         :: Vector Tileset
-                           -- ^ Array of Tilesets
-                         , tiledmapBackgroundcolor  :: Maybe String
-                           -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)
-                         , tiledmapRenderorder      :: String
-                           -- ^ Rendering direction (orthogonal maps only)
-                         , tiledmapProperties       :: Maybe [Property]
-                           -- ^ String key-value pairs
-                         , tiledmapNextobjectid     :: Int
-                           -- ^ Auto-increments for each placed object
-                         , tiledmapCompressionLevel :: Maybe Int
-                         , tiledmapInfinite         :: Bool
-                         , tiledmapNextlayerid      :: Maybe Int
-                         , tiledmapHexsidelength    :: Maybe Int
-                         , tiledmapStaggeraxis      :: Maybe Text
-                         , tiledmapStaggerindex     :: Maybe String
-                         , tiledmapType             :: String
-                         , tiledmapEditorsettings   :: Maybe Value
-                         } deriving (Eq, Generic, Show, NFData)
-
-instance FromJSON Tiledmap where
-  parseJSON = genericParseJSON (aesonOptions 8)
-instance ToJSON Tiledmap where
-  toJSON = genericToJSON (aesonOptions 8)
-
-data LoadResult = Loaded Tiledmap | IOErr String | DecodeErr String
-
--- | Load a Tiled map from the given 'FilePath'.
-loadTiledmap :: FilePath -> IO LoadResult
-loadTiledmap path = do
-  res <- try (BS.readFile path)
-  pure $ case res of
-    Right file ->  case eitherDecode . LB.fromStrict $ file of
-      Left err       -> DecodeErr err
-      Right tiledmap -> Loaded tiledmap
-    Left (err :: SomeException) -> IOErr $ show err