package.yaml

@@ -23,6 +23,7 @@ internal-libraries:
     exposed-modules:
       - Data.Tiled
       - Data.Tiled.Abstract
+      - Data.Tiled.TH
 
 library:
   source-dirs: 'lib'
@@ -60,27 +61,6 @@ executables:
       - aeson-pretty
       - template-haskell
       - process
-  cwality-maps:
-    main: Main.hs
-    source-dirs: 'cwality-maps'
-    ghc-options: -rtsopts -threaded
-    dependencies:
-      - tiled
-      - servant
-      - servant-server
-      - wai
-      - wai-extra
-      - warp
-      - monad-logger
-      - fmt
-      - tomland
-      - microlens-platform
-      - directory
-      - filepath
-      - containers
-      - base64
-      - parsec
-      - mustache
   walint-mapserver:
     main: Main.hs
     source-dirs: 'server'

server/Handlers.hs

@@ -17,7 +17,7 @@ module Handlers (
 import           Universum
 
 import           CheckDir               (DirResult (dirresultMaps))
-import           CheckMap               (MapResult (MapResult, mapresultBadges))
+import           CheckMap               (MapResult (..))
 import           Control.Concurrent.STM (TQueue, dupTChan, readTChan,
                                          writeTQueue)
 import           Data.Aeson             (ToJSON (..), (.=))
@@ -31,8 +31,8 @@ import           Network.WebSockets     (PendingConnection, acceptRequest,
 import           Servant                (Handler, err404, throwError)
 import           Server                 (JobStatus (..), Org (orgUrl),
                                          RemoteRef (reponame), ServerState,
-                                         Sha1, getJobStatus,
-                                         unState, adjustedWebPath)
+                                         Sha1, adjustedWebPath, getJobStatus,
+                                         unState)
 import           Worker                 (Job (Job))
 
 
@@ -60,6 +60,7 @@ instance ToJSON MapService where
         mapInfo rev mappath MapResult { .. } = A.object
                 [ "badges" .= mapresultBadges
                 -- TODO: type-safe url library for adding the slash?
+                , "jitsi" .= mapresultJitsis
                 , "url" .= (orgUrl org <> adjustedWebPath rev org <> "/" <> toText mappath) ]
 
 

server/HtmlOrphans.hs

@@ -26,10 +26,10 @@ import           Handlers        (AdminOverview (..))
 import           Lucid           (HtmlT, ToHtml)
 import           Lucid.Base      (ToHtml (toHtml))
 import           Lucid.Html5     (a_, body_, button_, class_, code_, disabled_,
-                                  div_, em_, h1_, h2_, h3_, h4_, h5_, head_,
-                                  href_, html_, id_, li_, link_, main_,
-                                  onclick_, p_, rel_, script_, span_, src_,
-                                  title_, type_, ul_)
+                                  div_, em_, h1_, h2_, h3_, h4_, head_, href_,
+                                  html_, id_, li_, link_, main_, onclick_, p_,
+                                  rel_, script_, span_, src_, title_, type_,
+                                  ul_)
 import           Server          (JobStatus (..),
                                   Org (Org, orgBacklinkPrefix, orgContactMail, orgHowtoLink, orgSlug),
                                   RemoteRef (RemoteRef, reponame, reporef, repourl),
@@ -114,9 +114,9 @@ instance ToHtml AdminOverview where
       if null jobs then em_ "(nothing yet)"
       else flip M.foldMapWithKey jobs $ \sha1 (ref, status, _lastvalid) -> li_ $ do
         case status of
-          Pending _          -> badge Info "pending"
-          (Linted res rev _) -> toHtml $ maximumLintLevel res
-          (Failed _)         -> badge Error "system error"
+          Pending _        -> badge Info "pending"
+          (Linted res _ _) -> toHtml $ maximumLintLevel res
+          (Failed _)       -> badge Error "system error"
         " "; a_ [href_ ("/status/"+|orgSlug org|+"/"+|prettySha sha1|+"/")] $ do
           mono $ toHtml $ reporef ref; " on "; mono $ toHtml $ repourl ref
 

server/Server.hs

@@ -54,11 +54,11 @@ import           LintConfig                   (ConfigKind (..), LintConfig,
 import           Servant                      (FromHttpApiData)
 import           Servant.Client               (BaseUrl, parseBaseUrl)
 import qualified Text.Show                    as TS
+import qualified Toml                         as T
 import           Toml                         (BiMap (BiMap), TomlBiMap,
                                                TomlBiMapError (ArbitraryError),
                                                TomlCodec,
                                                prettyTomlDecodeErrors, (.=))
-import qualified Toml                         as T
 import           WithCli                      (HasArguments)
 
 -- | a reference in a remote git repository
@@ -99,6 +99,7 @@ data Org (loaded :: Bool) = Org
   , orgRepos          :: [RemoteRef]
   , orgUrl            :: Text
   , orgWebdir         :: Text
+  , orgHumanWebdir    :: Text
   , orgBacklinkPrefix :: Text
   , orgContactMail    :: Text
   , orgHowtoLink      :: Maybe Text
@@ -163,6 +164,7 @@ orgCodec = Org
   <*> T.list remoteCodec "repo" .= orgRepos
   <*> T.text "url" .= orgUrl
   <*> T.text "webdir" .= orgWebdir
+  <*> T.text "webdir_human" .= orgHumanWebdir
   <*> T.text "backlink_prefix" .= orgBacklinkPrefix
   <*> T.text "contact_mail" .= orgContactMail
   <*> coerce (T.first T.text "howto_link") .= orgHowtoLink
@@ -217,9 +219,9 @@ data JobStatus
 
 instance TS.Show JobStatus where
   show = \case
-    Pending _        -> "Pending"
-    Linted res rev _ -> "Linted result"
-    Failed err       -> "Failed with: " <> show err
+    Pending _    -> "Pending"
+    Linted _ _ _ -> "Linted result"
+    Failed err   -> "Failed with: " <> show err
 
 -- | the server's global state; might eventually end up with more
 -- stuff in here, hence the newtype

server/Worker.hs

@@ -16,14 +16,13 @@ import           CheckDir                      (recursiveCheckDir,
 import           Control.Concurrent.Async      (async, link)
 import           Control.Concurrent.STM        (writeTChan)
 import           Control.Concurrent.STM.TQueue
-import           Control.Exception             (IOException, handle, throw)
+import           Control.Exception             (IOException, handle)
 import           Control.Monad.Logger          (logError, logErrorN, logInfoN,
                                                 runStdoutLoggingT)
 import qualified Data.Text                     as T
 import qualified Data.UUID                     as UUID
 import qualified Data.UUID.V4                  as UUID
 import           Fmt                           ((+|), (|+))
-import           GHC.IO.Exception              (ioException)
 import           LintConfig                    (stuffConfig)
 import           Server                        (Config, JobStatus (..),
                                                 Org (..),
@@ -98,6 +97,7 @@ runJob offline config Job {..} done = do
         $ readgit' gitdir ["rev-parse", toString ref]
 
       let outPath = adjustedPath rev jobOrg
+      let humanOutPath = orgHumanWebdir jobOrg <> "/" <> reponame jobRef
 
       callgit gitdir [ "worktree", "add", "--force", workdir, toString ref ]
 
@@ -106,13 +106,17 @@ runJob offline config Job {..} done = do
 
       liftIO (writeAdjustedRepository lintConfig workdir (toString outPath) res)
         >>= \case
-        ExitSuccess ->
+        ExitSuccess -> do
           logInfoN $ "linted map "+| (show jobRef :: Text) |+"."
+          logInfoN $ "symlinking"+|outPath|+"into human web dir at"+|humanOutPath|+""
+          liftIO $ callProcess "ln" [ "-sfn", toString outPath, toString humanOutPath ]
         ExitFailure 1 ->
           logInfoN $ "linted map "+| (show jobRef :: Text) |+ ", which failed."
-        ExitFailure 2 ->
+        ExitFailure 2 -> do
           -- TODO: shouldn't have linted this map at all
           logErrorN $ "outpath "+|outPath|+" already exists!"
+          logInfoN $ "symlinking"+|outPath|+"into human web dir at"+|humanOutPath|+""
+          liftIO $ callProcess "ln" [ "-sfn", toString outPath, toString humanOutPath ]
         ExitFailure _ ->
           -- writeAdjustedRepository does not return other codes
           $(logError) "wtf, this is impossible"

src/Version.hs

@@ -9,7 +9,7 @@ import qualified Language.Haskell.TH as TH
 import           System.Process      (readProcess)
 
 version :: String
-version = "walint divoc bb3 2022 (" <>
+version = "walint generic 2022 (" <>
     $(do
         hash <- liftIO $ catchAny (readProcess "git" ["rev-parse", "HEAD"] "")
                          (\_ -> pure "[unknown]")

stack.yaml

-resolver: lts-18.25
+resolver: lts-19.28
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -15,22 +15,11 @@ packages:
 # These entries can reference officially published versions as well as
 # forks / in-progress versions pinned to a git hash. For example:
 #
-extra-deps:
- - aeson-2.0.2.0
- - OneTuple-0.3.1@sha256:c4c1f2971fd41c964a1bbe433adeed4cad9d0f99d67430ff5e1be5a7d7ab2ca3,2240
- - semialign-1.2.0.1@sha256:5efc30d6f53f8d2a8a26d9bf3a57c0f20f4ba3086797ccaa615f644abc21d42e,2814
- - text-short-0.1.4@sha256:4f7a76e78baf391d262883007e8f8d8fb23a2805d56d9725d6abdf1428542e11,3575
- - time-compat-1.9.6.1@sha256:381a2e8ed6e41d20ff5929d12d25c1d9337d459de5964ef1d90b06d115b31f07,5033
- - HList-0.5.1.0@sha256:3ecb2d10ad2b3d36ad28e2f08505f9c3d7143ca737ef13b3e64db503635966c2,7525
- - cli-extras-0.1.0.2@sha256:404552a3e5e844f332fcf74858999b9b9b6d5dcab6017a9d5a48868715a21468,1996
- - logging-effect-1.3.12@sha256:72d168dd09887649ba9501627219b6027cbec2d5541931555b7885b133785ce3,1679
- - which-0.2@sha256:db82ca7d83d64cce8ad579756f02d27c5bd289806ee02474726f7fafb87318e8,858
- - cli-git-0.1.0.2@sha256:4e62e6b7357e4fe698df8b58ba53919f9d4a056e9617dbc00c869a365e316387,1122
- - servant-lucid-0.9.0.4@sha256:698db96903a145fdef40cc897f8790728642af917c37b941a98b2da872b65f08,1787
- - servant-websockets-2.0.0@sha256:6e9e3600bced90fd52ed3d1bf632205cb21479075b20d6637153cc4567000234,2253
-   # mustache is on stackage, but in a version that doesn't yet support aeson 2.0
- - mustache-2.4.0@sha256:bd1cfbd027c04d8329877e95413d34dc357d4bee041dd8978cd6a23b114fbda1,3180
 allow-newer: true
+extra-deps:
+- mustache-2.4.0@sha256:bd1cfbd027c04d8329877e95413d34dc357d4bee041dd8978cd6a23b114fbda1,3180
+- tomland-1.3.3.1@sha256:83a8fd26a97164100541f7b26aa40ffdc6f230b21e94cbb3eae1fb7093c4356e,8924
+- validation-selective-0.1.0.1@sha256:9a5aa8b801efc6a4ffb120e1b28e80c5f7d090043be56bba11222cd20c393044,3621
 
 # use aeson with a non-hash-floodable implementation
 flags:

stack.yaml.lock

@@ -5,99 +5,29 @@
 
 packages:
 - completed:
-    hackage: aeson-2.0.2.0@sha256:5720fffb7289366029f2b7940e9f8b22a1b4c282f0cef4710685b1d14d76bdc7,6327
     pantry-tree:
-      size: 37910
-      sha256: 6de8e70acd5ed455ac33d7496e8dbf994067f1f845dd420e7256623b2a8dee8b
-  original:
-    hackage: aeson-2.0.2.0
-- completed:
-    hackage: OneTuple-0.3.1@sha256:c4c1f2971fd41c964a1bbe433adeed4cad9d0f99d67430ff5e1be5a7d7ab2ca3,2240
-    pantry-tree:
-      size: 506
-      sha256: 7678e4fbd592b26bb241e56171f400a62f73bc1de8a7706fcc2fbce2a5ba9c20
-  original:
-    hackage: OneTuple-0.3.1@sha256:c4c1f2971fd41c964a1bbe433adeed4cad9d0f99d67430ff5e1be5a7d7ab2ca3,2240
-- completed:
-    hackage: semialign-1.2.0.1@sha256:5efc30d6f53f8d2a8a26d9bf3a57c0f20f4ba3086797ccaa615f644abc21d42e,2814
-    pantry-tree:
-      size: 537
-      sha256: 061a65f6c4355cc852cbfb0b4ad875814acf8f35edc7cefa4bf5b3e2c9b63e33
-  original:
-    hackage: semialign-1.2.0.1@sha256:5efc30d6f53f8d2a8a26d9bf3a57c0f20f4ba3086797ccaa615f644abc21d42e,2814
-- completed:
-    hackage: text-short-0.1.4@sha256:4f7a76e78baf391d262883007e8f8d8fb23a2805d56d9725d6abdf1428542e11,3575
-    pantry-tree:
-      size: 727
-      sha256: aa1040a3846f49461a4345e96f1a7d8367f00657f248c52cb7b76cb162dc8b10
-  original:
-    hackage: text-short-0.1.4@sha256:4f7a76e78baf391d262883007e8f8d8fb23a2805d56d9725d6abdf1428542e11,3575
-- completed:
-    hackage: time-compat-1.9.6.1@sha256:381a2e8ed6e41d20ff5929d12d25c1d9337d459de5964ef1d90b06d115b31f07,5033
-    pantry-tree:
-      size: 4113
-      sha256: dd54303f712dd2b8dc05942061921b0d06e0bd501b42c965a9ac6a0a37cd3128
-  original:
-    hackage: time-compat-1.9.6.1@sha256:381a2e8ed6e41d20ff5929d12d25c1d9337d459de5964ef1d90b06d115b31f07,5033
-- completed:
-    hackage: HList-0.5.1.0@sha256:3ecb2d10ad2b3d36ad28e2f08505f9c3d7143ca737ef13b3e64db503635966c2,7525
-    pantry-tree:
-      size: 5800
-      sha256: fe9d53555847bd16ffd46e3fb6013751c23f375a95d05b4d4c8de0bb22911e72
-  original:
-    hackage: HList-0.5.1.0@sha256:3ecb2d10ad2b3d36ad28e2f08505f9c3d7143ca737ef13b3e64db503635966c2,7525
-- completed:
-    hackage: cli-extras-0.1.0.2@sha256:404552a3e5e844f332fcf74858999b9b9b6d5dcab6017a9d5a48868715a21468,1996
-    pantry-tree:
-      size: 849
-      sha256: 0f78dd9ad144dd81d2567ff0c47c111e2764db1b48341b34a2026018fb7f01ff
-  original:
-    hackage: cli-extras-0.1.0.2@sha256:404552a3e5e844f332fcf74858999b9b9b6d5dcab6017a9d5a48868715a21468,1996
-- completed:
-    hackage: logging-effect-1.3.12@sha256:72d168dd09887649ba9501627219b6027cbec2d5541931555b7885b133785ce3,1679
-    pantry-tree:
-      size: 330
-      sha256: 3907e21147987af4f1590abce025e7439f0d338444f259791068c361d586117f
-  original:
-    hackage: logging-effect-1.3.12@sha256:72d168dd09887649ba9501627219b6027cbec2d5541931555b7885b133785ce3,1679
-- completed:
-    hackage: which-0.2@sha256:db82ca7d83d64cce8ad579756f02d27c5bd289806ee02474726f7fafb87318e8,858
-    pantry-tree:
-      size: 262
-      sha256: bef8458bddea924f3162e51fcef66cb3071f73c31d3dbb6d4029b0115af88a54
-  original:
-    hackage: which-0.2@sha256:db82ca7d83d64cce8ad579756f02d27c5bd289806ee02474726f7fafb87318e8,858
-- completed:
-    hackage: cli-git-0.1.0.2@sha256:4e62e6b7357e4fe698df8b58ba53919f9d4a056e9617dbc00c869a365e316387,1122
-    pantry-tree:
-      size: 269
-      sha256: 1e81c51e2b60db2b1784901cf0af33c67384f5412ad8edaad8a7068135f5217f
-  original:
-    hackage: cli-git-0.1.0.2@sha256:4e62e6b7357e4fe698df8b58ba53919f9d4a056e9617dbc00c869a365e316387,1122
-- completed:
-    hackage: servant-lucid-0.9.0.4@sha256:698db96903a145fdef40cc897f8790728642af917c37b941a98b2da872b65f08,1787
-    pantry-tree:
-      size: 392
-      sha256: 39e0e7b2b25980bfe4df036e89959188f9ef9e8c78c85e241fa9a682d1d78cf3
+      sha256: 44c4d43ecfe1fee11fb03ffd49b0580ed00eec5144067092801ef4256df77ef8
+      size: 1182
+    hackage: mustache-2.4.0@sha256:bd1cfbd027c04d8329877e95413d34dc357d4bee041dd8978cd6a23b114fbda1,3180
   original:
-    hackage: servant-lucid-0.9.0.4@sha256:698db96903a145fdef40cc897f8790728642af917c37b941a98b2da872b65f08,1787
+    hackage: mustache-2.4.0@sha256:bd1cfbd027c04d8329877e95413d34dc357d4bee041dd8978cd6a23b114fbda1,3180
 - completed:
-    hackage: servant-websockets-2.0.0@sha256:6e9e3600bced90fd52ed3d1bf632205cb21479075b20d6637153cc4567000234,2253
     pantry-tree:
-      size: 523
-      sha256: 085c6620bff7671bef1d969652a349271c3703fbf10dd753cb63ee1cd700bca5
+      sha256: 0e3bdbd32955944c3ee9ff0f47dc765d25ab6be4a336c6d735eed8eb9bc8ce27
+      size: 6430
+    hackage: tomland-1.3.3.1@sha256:83a8fd26a97164100541f7b26aa40ffdc6f230b21e94cbb3eae1fb7093c4356e,8924
   original:
-    hackage: servant-websockets-2.0.0@sha256:6e9e3600bced90fd52ed3d1bf632205cb21479075b20d6637153cc4567000234,2253
+    hackage: tomland-1.3.3.1@sha256:83a8fd26a97164100541f7b26aa40ffdc6f230b21e94cbb3eae1fb7093c4356e,8924
 - completed:
-    hackage: mustache-2.4.0@sha256:bd1cfbd027c04d8329877e95413d34dc357d4bee041dd8978cd6a23b114fbda1,3180
     pantry-tree:
-      size: 1182
-      sha256: 44c4d43ecfe1fee11fb03ffd49b0580ed00eec5144067092801ef4256df77ef8
+      sha256: bf72fe4304690da4b5bc6e5218b0f90b5613e7d658f3ce31731816a423fcbca6
+      size: 696
+    hackage: validation-selective-0.1.0.1@sha256:9a5aa8b801efc6a4ffb120e1b28e80c5f7d090043be56bba11222cd20c393044,3621
   original:
-    hackage: mustache-2.4.0@sha256:bd1cfbd027c04d8329877e95413d34dc357d4bee041dd8978cd6a23b114fbda1,3180
+    hackage: validation-selective-0.1.0.1@sha256:9a5aa8b801efc6a4ffb120e1b28e80c5f7d090043be56bba11222cd20c393044,3621
 snapshots:
 - completed:
-    size: 587393
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/25.yaml
-    sha256: 1b74fb5e970497b5aefae56703f1bd44aa648bd1a5ef95c1eb8c29775087e2bf
-  original: lts-18.25
+    sha256: 7f4393ad659c579944d12202cffb12d8e4b8114566b015f77bbc303a24cff934
+    size: 619405
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/28.yaml
+  original: lts-19.28

tiled/Data/Tiled.hs

-{-# LANGUAGE AllowAmbiguousTypes        #-}
 {-# LANGUAGE BangPatterns               #-}
 {-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
@@ -9,6 +8,9 @@
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+
 
 -- | 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/.
@@ -20,29 +22,18 @@ module Data.Tiled where
 
 import           Universum
 
-import           Data.Aeson       hiding (Object)
-import qualified Data.Aeson       as A
-import           Data.Aeson.Types (typeMismatch)
-import           Data.Char        (toLower)
+import           Control.Exception (IOException)
+import           Data.Aeson        hiding (Object)
+import qualified Data.Aeson        as A
+import           Data.Aeson.TH     (deriveJSON)
+import           Data.Aeson.Types  (typeMismatch)
+import           Data.Tiled.TH
 
 
--- | 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)
@@ -108,11 +99,6 @@ 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.
@@ -176,15 +162,6 @@ data Object = ObjectRectangle
   } 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
@@ -223,11 +200,6 @@ data Layer = Layer { layerWidth            :: Maybe Double
                    , 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
@@ -274,13 +246,6 @@ data Tile = Tile { tileId          :: Int
                  , 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
@@ -331,13 +296,6 @@ data Tileset = Tileset { tilesetFirstgid         :: GlobalId
 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
@@ -375,13 +333,19 @@ data Tiledmap = Tiledmap { tiledmapVersion          :: Value
                          , tiledmapEditorsettings   :: Maybe Value
                          } deriving (Eq, Generic, Show, NFData)
 
-instance FromJSON Tiledmap where
-  parseJSON = genericParseJSON (aesonOptions 8)
-instance ToJSON Tiledmap where
-  toJSON = genericToJSON (aesonOptions 8)
+
+$(deriveJSON (aesonOptions 5) ''Point)
+$(deriveJSON (aesonOptions 6) ''Object)
+$(deriveJSON (aesonOptions 5) ''Layer)
+$(deriveJSON (aesonOptions 4) ''Tile)
+$(deriveJSON (aesonOptions 7) ''Tileset)
+$(deriveJSON (aesonOptions 8) ''Tiledmap)
+
 
 -- | Load a Tiled map from the given 'FilePath'.
 loadTiledmap :: FilePath -> IO (Either String Tiledmap)
-loadTiledmap path = eitherDecodeFileStrict' path >>= \case
-  Left  err       -> pure $ Left err
-  Right !tiledmap -> evaluateNF tiledmap <&> Right
+loadTiledmap path = catch
+  (eitherDecodeFileStrict' path >>= \case
+    Left  err       -> pure $ Left err
+    Right !tiledmap -> evaluateNF tiledmap <&> Right)
+  (\(_ :: IOException) -> pure (Left $ "Failed to read this file."))

tiled/Data/Tiled/Abstract.hs

@@ -4,9 +4,9 @@ module Data.Tiled.Abstract where
 
 import           Universum
 
-import           Data.Tiled  (GlobalId, Layer (..), Object (..), Property (..),
-                              PropertyValue (..), Tile (..), Tiledmap (..),
-                              Tileset (..), mkTiledId)
+import           Data.Tiled  (GlobalId (..), Layer (..), Object (..),
+                              Property (..), PropertyValue (..), Tile (..),
+                              Tiledmap (..), Tileset (..))
 import qualified Data.Vector as V
 
 class HasProperties a where
@@ -81,4 +81,4 @@ instance IsProperty Text where
 layerIsEmpty :: HasData a => a -> Bool
 layerIsEmpty layer = case getData layer of
   Nothing -> True
-  Just d  -> all ((==) $ mkTiledId 0) d
+  Just d  -> all ((==) $ GlobalId 0) d

tiled/Data/Tiled/TH.hs

+module Data.Tiled.TH where
+
+import           Universum
+
+import qualified Data.Aeson.TH as TH
+import           Data.Char     (toLower)
+
+aesonOptions :: Int -> TH.Options
+aesonOptions l = TH.defaultOptions
+  { TH.omitNothingFields = True
+  , TH.rejectUnknownFields = True
+  -- can't be bothered to do a nicer prefix strip
+  , TH.fieldLabelModifier = drop l . map toLower
+  , TH.sumEncoding = TH.UntaggedValue
+  }

walint.cabal

 cabal-version: 2.0
 
--- This file has been generated from package.yaml by hpack version 0.34.5.
+-- This file has been generated from package.yaml by hpack version 0.34.7.
 --
 -- see: https://github.com/sol/hpack
 
@@ -29,6 +29,8 @@ library
       Properties
       Uris
       Paths_walint
+  autogen-modules:
+      Paths_walint
   hs-source-dirs:
       lib
   default-extensions:
@@ -60,8 +62,11 @@ library tiled
   exposed-modules:
       Data.Tiled
       Data.Tiled.Abstract
+      Data.Tiled.TH
   other-modules:
       Paths_walint
+  autogen-modules:
+      Paths_walint
   hs-source-dirs:
       tiled
   default-extensions:
@@ -76,46 +81,13 @@ library tiled
     , vector
   default-language: Haskell2010
 
-executable cwality-maps
-  main-is: Main.hs
-  other-modules:
-      Config
-      Substitute
-      Paths_walint
-  hs-source-dirs:
-      cwality-maps
-  default-extensions:
-      NoImplicitPrelude
-  ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors -rtsopts -threaded
-  build-depends:
-      aeson
-    , base
-    , base64
-    , bytestring
-    , containers
-    , directory
-    , filepath
-    , fmt
-    , microlens-platform
-    , monad-logger
-    , mustache
-    , parsec
-    , servant
-    , servant-server
-    , text
-    , tiled
-    , tomland
-    , universum
-    , wai
-    , wai-extra
-    , warp
-  default-language: Haskell2010
-
 executable walint
   main-is: Main.hs
   other-modules:
       Version
       Paths_walint
+  autogen-modules:
+      Paths_walint
   hs-source-dirs:
       src
   default-extensions:
@@ -142,6 +114,8 @@ executable walint-mapserver
       Server
       Worker
       Paths_walint
+  autogen-modules:
+      Paths_walint
   hs-source-dirs:
       server
   default-extensions: