diff options
Diffstat (limited to 'cwality-maps/Main.hs')
| -rw-r--r-- | cwality-maps/Main.hs | 73 |
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 |