summaryrefslogtreecommitdiff
path: root/cwality-maps/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'cwality-maps/Main.hs')
-rw-r--r--cwality-maps/Main.hs73
1 files changed, 11 insertions, 62 deletions
diff --git a/cwality-maps/Main.hs b/cwality-maps/Main.hs
index 8dde445..be2b0a6 100644
--- a/cwality-maps/Main.hs
+++ b/cwality-maps/Main.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
@@ -24,12 +25,7 @@ import qualified Data.Aeson as A
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Text.Encoding.Base64.URL (decodeBase64Unpadded)
-import Data.Tiled (GlobalId, LocalId,
- Tiledmap)
-import GHC.Generics (Generic (Rep, from, to),
- K1 (K1), M1 (M1), U1,
- type (:*:) ((:*:)),
- type (:+:) (..))
+import Data.Tiled (Tiledmap)
import Network.Wai.Handler.Warp (defaultSettings,
runSettings, setPort)
import Network.Wai.Middleware.Gzip (def)
@@ -40,12 +36,13 @@ import Servant (Application, Capture,
CaptureAll,
FromHttpApiData (parseUrlPiece),
Get, Handler, JSON, Raw,
- Server, err400,
- err404, serve,
- throwError,
+ Server, err400, err404,
+ serve, throwError,
type (:<|>) (..),
type (:>))
import Servant.Server.StaticFiles (serveDirectoryWebApp)
+import Substitute (Substitutable (substitute),
+ SubstitutionError)
-- | a map's filename ending in .json
-- (a newtype to differentiate between maps and assets in a route)
@@ -88,59 +85,8 @@ type Routes =
-class Substitutable s where
- substitute :: s -> Map Text Text -> s
-instance Substitutable Text where
- substitute orig subst = "meow" -- TODO: write a simple lexer to replace @vars@ or sth
-
-instance {-# OVERLAPS #-} Substitutable String where
- substitute orig substs = toString (substitute (toText orig) substs)
-
-instance {-# OVERLAPPING #-} (Functor a, Substitutable b) => Substitutable (a b) where
- substitute orig subst = map (`substitute` subst) orig
-
-instance {-# OVERLAPS #-} Substitutable A.Value where
- substitute = const
-
-instance Substitutable Int where
- substitute = const
-
-instance Substitutable GlobalId where
- substitute = const
-
-instance Substitutable LocalId where
- substitute = const
-
-instance Substitutable Double where
- substitute = const
-
-instance Substitutable Float where
- substitute = const
-
-class GSubstitutable i where
- gsubstitute :: i p -> Map Text Text -> i p
-
-instance Substitutable c => GSubstitutable (K1 i c) where
- gsubstitute (K1 text) = K1 . substitute text
-
-instance (GSubstitutable a, GSubstitutable b) => GSubstitutable (a :*: b) where
- gsubstitute (a :*: b) substs = gsubstitute a substs :*: gsubstitute b substs
-
-instance (GSubstitutable a, GSubstitutable b) => GSubstitutable (a :+: b) where
- gsubstitute (L1 a) = L1 . gsubstitute a
- gsubstitute (R1 a) = R1 . gsubstitute a
-
-instance (GSubstitutable a) => GSubstitutable (M1 x y a) where
- gsubstitute (M1 a) = M1 . gsubstitute a
-
-instance GSubstitutable U1 where
- gsubstitute = const
-
-instance {-# OVERLAPPABLE #-} (GSubstitutable (Rep a), Generic a) => Substitutable a where
- substitute a substs = to (gsubstitute (from a) substs)
-
-mkMap :: Config True -> Tiledmap -> MapParams -> Tiledmap
+mkMap :: Config True -> Tiledmap -> MapParams -> ([SubstitutionError], Tiledmap)
mkMap _config basemap params =
substitute basemap (substs params)
@@ -148,7 +94,10 @@ mkMap _config basemap params =
mapHandler :: Config True -> JsonFilename -> MapParams -> Handler Tiledmap
mapHandler config (JsonFilename mapname) params =
case M.lookup mapname (snd $ view template config) of
- Just basemap -> pure $ mkMap config basemap params
+ Just basemap -> do
+ let (errors, map) = mkMap config basemap params
+ print errors
+ pure map
Nothing -> throwError err404
-- | Complete set of routes: API + HTML sites