{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} module Nomyx.Core.Serialize where import Prelude hiding (log, (.)) import Control.Category import Control.Lens hiding ((.=)) import Control.Monad.State import Data.Yaml as Yaml (decodeEither, encode) import qualified Data.Aeson as Json (eitherDecode, encode) import Data.List import qualified Data.Text.IO as DT import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import Nomyx.Core.Engine import Nomyx.Core.Engine.Interpret import Nomyx.Core.Types import Nomyx.Core.Utils import Nomyx.Language import System.FilePath save :: Multi -> IO () save m = BL.writeFile (getSaveFile $ _mSettings m) (Json.encode m) save' :: StateT Multi IO () save' = get >>= lift . save load :: FilePath -> IO Multi load fp = do s <- BL.readFile fp case Json.eitherDecode s of Left e -> error $ "error decoding save file: " ++ e Right a -> return a loadMulti :: Settings -> IO Multi loadMulti s = do let sd = getSaveFile s m <- load sd gs' <- mapM updateGameInfo (_gameInfos m) let m' = set gameInfos gs' m let m'' = set mSettings s m' return m'' updateGameInfo :: GameInfo -> IO GameInfo updateGameInfo gi = do gi' <- updateLoggedGame (_loggedGame gi) return $ gi {_loggedGame = gi'} updateLoggedGame :: LoggedGame -> IO LoggedGame updateLoggedGame (LoggedGame g log) = getLoggedGame g log -- read a library file readLibrary :: FilePath -> IO Library readLibrary yamlFile = do let dir = takeDirectory yamlFile ts <- readTemplates yamlFile let mods = nub $ join [ms | (RuleTemplate _ _ _ _ _ _ ms) <- ts] ms <- mapM (readModule dir) mods return $ Library ts ms readTemplates :: FilePath -> IO [RuleTemplate] readTemplates yamlFile = do s <- BC.readFile yamlFile case Yaml.decodeEither s of Left e -> error $ "error decoding library: " ++ e Right ts -> return ts readModule :: FilePath -> FilePath -> IO ModuleInfo readModule basePath mod = do let absPath = basePath mod content <- DT.readFile absPath return $ ModuleInfo mod content -- write a library file writeLibrary :: FilePath -> Library -> IO () writeLibrary yamlFile (Library ts ms) = do let dir = takeDirectory yamlFile putStrLn $ "saving templates: " ++ yamlFile BC.writeFile yamlFile (Yaml.encode ts) mapM_ (saveModule dir) ms