separate tiled modules out into own package

8 files changed, 7 insertions, 468 deletions

diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index be23747..93b6345 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -40,7 +40,7 @@ import           System.FilePath        (splitPath, (</>))
 import qualified System.FilePath        as FP
 import           System.FilePath.Posix  (takeDirectory)
 import           Text.Dot               (showDot)
-import           Tiled                  (Tiledmap)
+import           Data.Tiled                  (Tiledmap)
 import           Types                  (Dep (Local, LocalMap), Hint (Hint),
                                          Level (..), hintLevel)
 import           Util                   (PrettyPrint (prettyprint))
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 3ac03bd..0b5b58a 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -32,7 +32,7 @@ import           LintWriter       (LintResult, invertLintResult,
                                    runLintWriter)
 import           Properties       (checkLayer, checkMap, checkTileset)
 import           System.FilePath  (takeFileName)
-import           Tiled            (Layer (layerLayers, layerName),
+import           Data.Tiled            (Layer (layerLayers, layerName),
                                    LoadResult (..),
                                    Tiledmap (tiledmapLayers, tiledmapTilesets),
                                    loadTiledmap)
diff --git a/lib/LayerData.hs b/lib/LayerData.hs
index 6956c92..46d6449 100644
--- a/lib/LayerData.hs
+++ b/lib/LayerData.hs
@@ -8,7 +8,7 @@ import           Control.Monad.Zip (mzipWith)
 import           Data.Set          (insert)
 import           Data.Vector       (maximum, uncons)
 import qualified Text.Show         as TS
-import           Tiled             (GlobalId (unGlobalId), Layer (..))
+import           Data.Tiled             (GlobalId (unGlobalId), Layer (..))
 import           Util              (PrettyPrint (..))
 
 -- | A collision between two layers of the given names.
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index d0c6c4e..b55b16e 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -48,7 +48,7 @@ import           Universum
 import           Badges        (Badge)
 import           Data.Map      (fromListWith)
 import           LintConfig    (LintConfig')
-import           TiledAbstract (HasName (getName))
+import           Data.Tiled.Abstract (HasName (getName))
 import           Types         (Dep, Hint, Level (..), Lint (..), hint,
                                 lintsToHints)
 
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 5d9c094..1ba5faa 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -18,10 +18,10 @@ import           Universum         hiding (intercalate, isPrefixOf)
 import           Data.Text         (intercalate, isInfixOf, isPrefixOf)
 import qualified Data.Text         as T
 import qualified Data.Vector       as V
-import           Tiled             (Layer (..), Object (..), Property (..),
+import           Data.Tiled             (Layer (..), Object (..), Property (..),
                                     PropertyValue (..), Tile (..),
                                     Tiledmap (..), Tileset (..))
-import           TiledAbstract     (HasName (..), HasProperties (..),
+import           Data.Tiled.Abstract     (HasName (..), HasProperties (..),
                                     HasTypeName (..), IsProperty (..))
 import           Util              (layerIsEmpty, mkProxy, naiveEscapeHTML,
                                     prettyprint)
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
diff --git a/lib/TiledAbstract.hs b/lib/TiledAbstract.hs
deleted file mode 100644
index 9fd2df0..0000000
--- a/lib/TiledAbstract.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module TiledAbstract where
-
-import           Universum
-
-import qualified Data.Vector as V
-import           Tiled       (Layer (..), Object (..), Property (..),
-                              PropertyValue (..), Tile (..), Tiledmap (..),
-                              Tileset (..))
-
-class HasProperties a where
-  getProperties :: a -> [Property]
-  adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a
-
-instance HasProperties Layer where
-  getProperties = maybeToMonoid . layerProperties
-  adjustProperties f layer = layer
-    { layerProperties = f (getProperties layer) }
-
-instance HasProperties Tileset where
-  getProperties = maybeToMonoid . tilesetProperties
-  adjustProperties f tileset = tileset
-    { tilesetProperties = f (getProperties tileset) }
-
-instance HasProperties Tile where
-  getProperties = V.toList . maybeToMonoid . tileProperties
-  adjustProperties f tile = tile
-    { tileProperties = (fmap V.fromList . f) (getProperties tile) }
-
-instance HasProperties Object where
-  getProperties = V.toList . maybeToMonoid . objectProperties
-  adjustProperties f obj = obj
-    { objectProperties = (fmap V.fromList . f) (getProperties obj) }
-
-instance HasProperties Tiledmap where
-  getProperties = maybeToMonoid . tiledmapProperties
-  adjustProperties f tiledmap = tiledmap
-    { tiledmapProperties = f (getProperties tiledmap) }
-
-class HasTypeName a where
-  typeName :: Proxy a -> Text
-instance HasTypeName Layer where
-  typeName _ = "layer"
-instance HasTypeName Tileset where
-  typeName _ = "tileset"
-instance HasTypeName Property where
-  typeName _ = "property"
-
-class HasName a where
-  getName :: a -> Text
-instance HasName Layer where
-  getName = layerName
-instance HasName Tileset where
-  getName = tilesetName
-instance HasName Property where
-  getName (Property n _) = n
-
-class IsProperty a where
-  asProperty :: a -> PropertyValue
-instance IsProperty PropertyValue where
-  asProperty = id
-  {-# INLINE asProperty #-}
-instance IsProperty Text where
-  asProperty = StrProp
-  {-# INLINE asProperty #-}
diff --git a/lib/Util.hs b/lib/Util.hs
index f935e78..ccd2ef3 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -17,7 +17,7 @@ import           Universum
 import           Data.Aeson as Aeson
 import qualified Data.Set   as S
 import qualified Data.Text  as T
-import           Tiled      (Layer (layerData), PropertyValue (..),
+import           Data.Tiled      (Layer (layerData), PropertyValue (..),
                              Tileset (tilesetName), layerName, mkTiledId)
 
 mkProxy :: a -> Proxy a