Tiled.hs

{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# 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           Control.Exception      (try)
import           Control.Exception.Base (SomeException)
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)
import           Data.Map               (Map)
import           Data.String            (IsString (fromString))
import           Data.Text              (Text)
import qualified Data.Text              as T
import           Data.Vector            (Vector)
import           GHC.Generics           (Generic)


-- | 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 (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey)

mkTiledId :: Int -> GlobalId
mkTiledId i = GlobalId { unGlobalId = i }

-- | A locally indexed identifier.
newtype LocalId = LocalId { unLocalId :: Int }
  deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey)

-- | TODO: type-check colours?
type Color = Text

-- | A custom tiled property, which just has a name and a value.
data Property = Property Text PropertyValue
  deriving (Eq, Generic, Show)

-- | 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)

instance IsString PropertyValue where
  fromString s = StrProp (T.pack s)