From 3fa02bb09b574bbccf9fc9faadb94f9c61d60e6c Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 28 Feb 2022 00:40:34 +0100
Subject: little server for making cwality maps (which meow, for now)

---
 cwality-maps/Config.hs | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 cwality-maps/Config.hs

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

diff --git a/cwality-maps/Config.hs b/cwality-maps/Config.hs
new file mode 100644
index 0000000..1317f72
--- /dev/null
+++ b/cwality-maps/Config.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE KindSignatures    #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TupleSections     #-}
+{-# LANGUAGE TypeFamilies      #-}
+
+module Config ( loadConfig
+              , Config, port, verbose, template
+              ) where
+
+import           Universum
+
+import           Data.List           (isSuffixOf)
+import qualified Data.Map.Strict     as M
+import           Data.Tiled          (LoadResult (Loaded), Tiledmap,
+                                      loadTiledmap)
+import           Lens.Micro.Platform (makeLenses, traverseOf)
+import           System.Directory    (listDirectory)
+import           System.FilePath     ((</>))
+import           Toml                (TomlCodec, (.=))
+import qualified Toml                as T
+
+type family ConfigRes (b :: Bool) a where
+  ConfigRes True a = a
+  ConfigRes False a = FilePath
+
+-- | the server's configuration
+data Config (loaded :: Bool) = Config
+  { _port     :: Int
+  , _verbose  :: Bool
+  , _template :: ConfigRes loaded (FilePath, Map Text Tiledmap)
+  } deriving Generic
+
+makeLenses ''Config
+
+
+configCodec :: TomlCodec (Config False)
+configCodec = Config
+    <$> T.int "port" .= _port
+    <*> T.bool "verbose" .= _verbose
+    <*> T.string "template" .= _template
+
+loadConfig :: FilePath -> IO (Config True)
+loadConfig path = do
+  T.decodeFileEither configCodec path >>= \case
+    Right c  -> traverseOf template loadMaps c
+    Left err -> error (show err)
+    where loadMaps path = do
+            maps <- listDirectory path
+              <&> filter (".json" `isSuffixOf`)
+
+            list <- forM maps $ \mapname ->
+              loadTiledmap (path </> mapname) >>= \case
+                Loaded tmap -> pure (toText mapname, tmap)
+                err         -> error (show err)
+
+            pure (path, M.fromList list)
-- 
cgit v1.2.3