diff options
author | stuebinm | 2022-10-11 11:28:30 +0200 |
---|---|---|
committer | stuebinm | 2022-10-11 11:28:30 +0200 |
commit | a29be8315c2e6647a5878529affda84ec8036ccb (patch) | |
tree | 9e5973c8e4a149dfcf2b20fcff6c08fe8c90fe59 /cwality-maps/Config.hs | |
parent | b6bc6c59c003cfbcfad2d5b1cf8809476f60fa17 (diff) |
update stack resolver
(also got rid of the map templater, which had version problems with
mustache — it's not likely anyone will need it anyways)
Diffstat (limited to '')
-rw-r--r-- | cwality-maps/Config.hs | 61 |
1 files changed, 0 insertions, 61 deletions
diff --git a/cwality-maps/Config.hs b/cwality-maps/Config.hs deleted file mode 100644 index 38c61ed..0000000 --- a/cwality-maps/Config.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-# 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 (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 - Right tmap -> pure (toText mapname, tmap) - err -> error (show err) - - pure (path, M.fromList list) |