From ce2210e6deff1d981186b6d7ddb1176f27e41f49 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 13 Jun 2020 03:41:39 +0200
Subject: compiler: make GalleryIndex loadable from JSON

---
 compiler/src/Compiler.hs |  4 ++--
 compiler/src/Config.hs   |  2 +-
 compiler/src/Files.hs    | 14 ++++++++++----
 compiler/src/Resource.hs | 28 +++++++++++++++-------------
 4 files changed, 28 insertions(+), 20 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 2bb27f9..5a7632d 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -29,7 +29,7 @@ import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
 import System.Directory (canonicalizePath)
 
-import Data.Aeson (ToJSON)
+import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
 import Config
@@ -64,7 +64,7 @@ thumbnailsDir = "thumbnails"
 data GalleryIndex = GalleryIndex
   { properties :: ViewerConfig
   , tree :: GalleryItem
-  } deriving (Generic, Show, ToJSON)
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 writeJSON :: ToJSON a => FileName -> a -> IO ()
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 3c38a17..afcfb36 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -84,7 +84,7 @@ readConfig = decodeYamlFile
 data ViewerConfig = ViewerConfig
   { galleryTitle :: String
   , tagCategories :: [String]
-  } deriving (Generic, ToJSON, Show)
+  } deriving (Generic, ToJSON, FromJSON, Show)
 
 viewerConfig :: GalleryConfig -> ViewerConfig
 viewerConfig GalleryConfig{galleryTitle, tagCategories} = ViewerConfig galleryTitle tagCategories
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 1f14e7f..023546b 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -20,7 +20,7 @@ module Files
   ( FileName, LocalPath, WebPath, Path(..)
   , (</>), (</), (/>), (<.>)
   , fileName, subPaths, pathLength
-  , localPath, webPath
+  , localPath, webPath, fromWebPath
   , FSNode(..), AnchoredFSNode(..)
   , nodeName, isHidden, flattenDir, filterDir
   , readDirectory, copyTo
@@ -31,8 +31,8 @@ module Files
 import Data.List (isPrefixOf, length, sortOn)
 import Data.Function ((&))
 import Data.Functor ((<&>))
-import Data.Text (pack)
-import Data.Aeson (ToJSON)
+import Data.Text (pack, unpack)
+import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
 import System.Directory
@@ -59,8 +59,11 @@ newtype Path = Path [FileName] deriving Show
 instance ToJSON Path where
   toJSON = JSON.String . pack . webPath
 
+instance FromJSON Path where
+  parseJSON = JSON.withText "Path" (return . fromWebPath . unpack)
+
 instance Eq Path where
-  (Path left) == (Path right) = left == right
+  left == right = webPath left == webPath right
 
 (</>) :: Path -> Path -> Path
 (Path l) </> (Path r) = Path (r ++ l)
@@ -95,6 +98,9 @@ localPath (Path path) = System.FilePath.joinPath $ reverse path
 webPath :: Path -> WebPath
 webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
 
+fromWebPath :: WebPath -> Path
+fromWebPath = Path . reverse . System.FilePath.Posix.splitDirectories
+
 
 data FSNode =
     File
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 607c7f6..fa139e0 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -31,14 +31,14 @@ import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
 import Data.Functor ((<&>))
 import qualified Data.Set as Set
-import Data.Text (pack)
+import Data.Text (pack, unpack, breakOn)
 import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
-import Data.Time.Format (formatTime, defaultTimeLocale)
+import Data.Time.Format (formatTime, parseTimeM, defaultTimeLocale)
 import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
-import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
+import Data.Aeson (ToJSON, FromJSON, genericToJSON, genericToEncoding, genericParseJSON)
 import qualified Data.Aeson as JSON
 
 import Files
@@ -70,6 +70,13 @@ instance ToJSON Resource where
     where
       timestamp = formatTime defaultTimeLocale "%s" modTime
 
+instance FromJSON Resource where
+  parseJSON = JSON.withText "Resource" (unpackRes . breakOn "?")
+    where
+      unpackRes (resPathStr, modTimeStr) =
+        Resource (fromWebPath $ unpack resPathStr)
+        <$> parseTimeM True defaultTimeLocale "?%s" (unpack modTimeStr)
+
 
 data GalleryItemProps =
     Directory { items :: [GalleryItem] }
@@ -87,15 +94,14 @@ instance ToJSON GalleryItemProps where
   toJSON = genericToJSON encodingOptions
   toEncoding = genericToEncoding encodingOptions
 
+instance FromJSON GalleryItemProps where
+  parseJSON = genericParseJSON encodingOptions
+
 
 data Thumbnail = Thumbnail
   { resource :: Resource
   , resolution :: Resolution
-  } deriving (Generic, Show)
-
-instance ToJSON Thumbnail where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 data GalleryItem = GalleryItem
@@ -106,11 +112,7 @@ data GalleryItem = GalleryItem
   , path :: Path
   , thumbnail :: Maybe Thumbnail
   , properties :: GalleryItemProps
-  } deriving (Generic, Show)
-
-instance ToJSON GalleryItem where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 type ItemProcessor = Path -> IO GalleryItemProps
-- 
cgit v1.2.3