From 99288bc78efc56a5ef05738d365ac6e007adfd10 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 3 Mar 2022 15:57:21 +0100
Subject: cwality-maps: add mustache templating

not going to be my faviourite templating language, but it seems to work
pretty well for this.
---
 cwality-maps/Main.hs | 73 ++++++++--------------------------------------------
 1 file changed, 11 insertions(+), 62 deletions(-)

(limited to 'cwality-maps/Main.hs')

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
-- 
cgit v1.2.3