aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/Files.hs45
-rw-r--r--compiler/src/Gallery.hs20
-rw-r--r--compiler/src/Input.hs4
-rw-r--r--compiler/src/Processors.hs10
-rw-r--r--compiler/src/Resource.hs4
5 files changed, 51 insertions, 32 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index d1363a1..457f1da 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -23,7 +23,8 @@
23 23
24module Files 24module Files
25 ( FileName, LocalPath, WebPath, Path 25 ( FileName, LocalPath, WebPath, Path
26 , (</>), (</), (/>), (<.>), localPath, webPath 26 , (</>), (</), (/>), (<.>), fileName, subPaths, pathLength
27 , localPath, webPath
27 , FSNode(..), AnchoredFSNode(..) 28 , FSNode(..), AnchoredFSNode(..)
28 , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory 29 , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
29 , ensureParentDir, remove, isOutdated 30 , ensureParentDir, remove, isOutdated
@@ -32,8 +33,12 @@ module Files
32 33
33import Control.Monad (filterM, mapM) 34import Control.Monad (filterM, mapM)
34import Data.Bool (bool) 35import Data.Bool (bool)
35import Data.List (isPrefixOf, length, deleteBy) 36import Data.List (isPrefixOf, length, deleteBy, subsequences)
36import Data.Function ((&)) 37import Data.Function ((&))
38import Data.Text (pack)
39import Data.Aeson (ToJSON)
40import qualified Data.Aeson as JSON
41
37import System.Directory 42import System.Directory
38 ( doesDirectoryExist 43 ( doesDirectoryExist
39 , doesPathExist 44 , doesPathExist
@@ -51,25 +56,41 @@ type LocalPath = String
51type WebPath = String 56type WebPath = String
52 57
53 -- | Reversed path component list 58 -- | Reversed path component list
54type Path = [FileName] 59data Path = Path [FileName] deriving Show
60
61instance ToJSON Path where
62 toJSON = JSON.String . pack . webPath
63
64instance Eq Path where
65 (Path left) == (Path right) = left == right
55 66
56(</>) :: Path -> Path -> Path 67(</>) :: Path -> Path -> Path
57l </> r = r ++ l 68(Path l) </> (Path r) = Path (r ++ l)
58 69
59(</) :: Path -> FileName -> Path 70(</) :: Path -> FileName -> Path
60path </ file = file:path 71(Path path) </ file = Path (file:path)
61 72
62(/>) :: FileName -> Path -> Path 73(/>) :: FileName -> Path -> Path
63file /> path = path ++ [file] 74file /> (Path path) = Path (path ++ [file])
64 75
65(<.>) :: Path -> String -> Path 76(<.>) :: Path -> String -> Path
66(filename:pathto) <.> ext = System.FilePath.addExtension filename ext : pathto 77(Path (filename:pathto)) <.> ext =
78 Path $ System.FilePath.addExtension filename ext : pathto
79
80fileName :: Path -> FileName
81fileName (Path (name:_)) = name
82
83subPaths :: Path -> [Path]
84subPaths (Path path) = map (Path . subsequences) path
85
86pathLength :: Path -> Int
87pathLength (Path path) = Data.List.length path
67 88
68localPath :: Path -> LocalPath 89localPath :: Path -> LocalPath
69localPath = System.FilePath.joinPath . reverse 90localPath (Path path) = System.FilePath.joinPath $ reverse path
70 91
71webPath :: Path -> WebPath 92webPath :: Path -> WebPath
72webPath = System.FilePath.Posix.joinPath . reverse 93webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
73 94
74 95
75data FSNode = File Path | Dir Path [FSNode] deriving Show 96data FSNode = File Path | Dir Path [FSNode] deriving Show
@@ -82,10 +103,10 @@ nodePath (File path) = path
82nodePath (Dir path _) = path 103nodePath (Dir path _) = path
83 104
84nodeName :: FSNode -> FileName 105nodeName :: FSNode -> FileName
85nodeName = head . nodePath 106nodeName = fileName . nodePath
86 107
87isHidden :: FSNode -> Bool 108isHidden :: FSNode -> Bool
88isHidden node = "." `isPrefixOf` filename && length filename > 1 109isHidden node = "." `isPrefixOf` filename &&length filename > 1
89 where filename = nodeName node 110 where filename = nodeName node
90 111
91-- | DFS with intermediate dirs first. 112-- | DFS with intermediate dirs first.
@@ -104,7 +125,7 @@ filterDir cond (AnchoredFSNode anchor root) =
104 filter cond items & map filterNode & Dir path 125 filter cond items & map filterNode & Dir path
105 126
106readDirectory :: LocalPath -> IO AnchoredFSNode 127readDirectory :: LocalPath -> IO AnchoredFSNode
107readDirectory root = mkNode [] >>= return . AnchoredFSNode root 128readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
108 where 129 where
109 mkNode :: Path -> IO FSNode 130 mkNode :: Path -> IO FSNode
110 mkNode path = 131 mkNode path =
diff --git a/compiler/src/Gallery.hs b/compiler/src/Gallery.hs
index 1fa4036..a1b1674 100644
--- a/compiler/src/Gallery.hs
+++ b/compiler/src/Gallery.hs
@@ -86,8 +86,8 @@ data GalleryItem = GalleryItem
86 , date :: String -- TODO: checked ISO8601 date 86 , date :: String -- TODO: checked ISO8601 date
87 , description :: String 87 , description :: String
88 , tags :: [Tag] 88 , tags :: [Tag]
89 , path :: ResourcePath 89 , path :: Path
90 , thumbnail :: Maybe ResourcePath 90 , thumbnail :: Maybe Path
91 , properties :: GalleryItemProps 91 , properties :: GalleryItemProps
92 } deriving (Generic, Show) 92 } deriving (Generic, Show)
93 93
@@ -97,30 +97,30 @@ instance ToJSON GalleryItem where
97 97
98 98
99buildGalleryTree :: ResourceTree -> GalleryItem 99buildGalleryTree :: ResourceTree -> GalleryItem
100buildGalleryTree (ItemResource sidecar path@(filename:_) thumbnail) = 100buildGalleryTree (ItemResource sidecar path thumbnail) =
101 GalleryItem 101 GalleryItem
102 { title = optMeta title filename 102 { title = optMeta title $ fileName path
103 , date = optMeta date "" -- TODO: check and normalise dates 103 , date = optMeta date "" -- TODO: check and normalise dates
104 , description = optMeta description "" 104 , description = optMeta description ""
105 , tags = optMeta tags [] 105 , tags = optMeta tags []
106 , path = webPath path 106 , path = path
107 , thumbnail = fmap webPath thumbnail 107 , thumbnail = thumbnail
108 , properties = Unknown } -- TODO 108 , properties = Unknown } -- TODO
109 where 109 where
110 optMeta :: (Sidecar -> Maybe a) -> a -> a 110 optMeta :: (Sidecar -> Maybe a) -> a -> a
111 optMeta get fallback = fromMaybe fallback $ get sidecar 111 optMeta get fallback = fromMaybe fallback $ get sidecar
112 112
113buildGalleryTree (DirResource dirItems path@(dirname:_) thumbnail) = 113buildGalleryTree (DirResource dirItems path thumbnail) =
114 map buildGalleryTree dirItems 114 map buildGalleryTree dirItems
115 & \items -> GalleryItem 115 & \items -> GalleryItem
116 { title = dirname 116 { title = fileName path
117 -- TODO: consider using the most recent item's date? what if empty? 117 -- TODO: consider using the most recent item's date? what if empty?
118 , date = "" 118 , date = ""
119 -- TODO: consider allowing metadata sidecars for directories too 119 -- TODO: consider allowing metadata sidecars for directories too
120 , description = "" 120 , description = ""
121 , tags = aggregateChildTags items 121 , tags = aggregateChildTags items
122 , path = webPath path 122 , path = path
123 , thumbnail = fmap webPath thumbnail 123 , thumbnail = thumbnail
124 , properties = Directory items } 124 , properties = Directory items }
125 where 125 where
126 aggregateChildTags :: [GalleryItem] -> [Tag] 126 aggregateChildTags :: [GalleryItem] -> [Tag]
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index 597394e..cb9fc60 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -92,7 +92,7 @@ readInputTree :: AnchoredFSNode -> IO InputTree
92readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root 92readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
93 where 93 where
94 mkInputNode :: FSNode -> IO (Maybe InputTree) 94 mkInputNode :: FSNode -> IO (Maybe InputTree)
95 mkInputNode (File path@(filename:_)) | not (sidecarExt `isExtensionOf` filename) = 95 mkInputNode (File path) | not (sidecarExt `isExtensionOf` (fileName path)) =
96 readSidecarFile (localPath $ anchor /> path <.> sidecarExt) 96 readSidecarFile (localPath $ anchor /> path <.> sidecarExt)
97 >>= return . InputFile path 97 >>= return . InputFile path
98 >>= return . Just 98 >>= return . Just
@@ -110,4 +110,4 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
110 110
111 matchThumbnail :: FSNode -> Bool 111 matchThumbnail :: FSNode -> Bool
112 matchThumbnail Dir{} = False 112 matchThumbnail Dir{} = False
113 matchThumbnail (File (filename:_)) = (dropExtension filename) == "thumbnail" 113 matchThumbnail (File path) = (dropExtension $ fileName path) == "thumbnail"
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 7362822..ded3cc5 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -59,8 +59,8 @@ data Format =
59 | Gif -- TODO: might be animated 59 | Gif -- TODO: might be animated
60 | Other 60 | Other
61 61
62formatFromExt :: String -> Format 62formatFromPath :: Path -> Format
63formatFromExt = aux . (map toLower) 63formatFromPath = aux . (map toLower) . fileName
64 where 64 where
65 aux ".bmp" = Bmp 65 aux ".bmp" = Bmp
66 aux ".jpg" = Jpg 66 aux ".jpg" = Jpg
@@ -169,10 +169,9 @@ type ItemFileProcessor =
169 169
170itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor 170itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
171itemFileProcessor maxRes cached inputBase outputBase resClass inputRes = 171itemFileProcessor maxRes cached inputBase outputBase resClass inputRes =
172 cached (processor maxRes (extOf inputRes)) inPath outPath 172 cached (processor maxRes (formatFromPath inputRes)) inPath outPath
173 >> return relOutPath 173 >> return relOutPath
174 where 174 where
175 extOf = formatFromExt . takeExtension . head
176 relOutPath = resClass /> inputRes 175 relOutPath = resClass /> inputRes
177 inPath = localPath $ inputBase /> inputRes 176 inPath = localPath $ inputBase /> inputRes
178 outPath = localPath $ outputBase /> relOutPath 177 outPath = localPath $ outputBase /> relOutPath
@@ -196,10 +195,9 @@ type ThumbnailFileProcessor =
196 195
197thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor 196thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
198thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = 197thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
199 cached <$> processor (extOf inputRes) 198 cached <$> processor (formatFromPath inputRes)
200 & process 199 & process
201 where 200 where
202 extOf = formatFromExt . takeExtension . head
203 relOutPath = resClass /&