Learn to initialise projects with configurable themes

[xyz.git] / src / Lib.hs

diff --git a/src/Lib.hs b/src/Lib.hs
index 1954a89..1ba6286 100644 (file)
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 module Lib
-    ( someFunc
+    ( someFunc, EntryList, allFilesIn, ProjectConfig
     ) where
 
 import Data.Function (on)
@@ -17,7 +19,27 @@ import Data.Time.Format
 import Data.Time.LocalTime
 import Prelude hiding (lines)
 import System.Directory
-import System.FilePath.Posix (takeBaseName)
+import System.FilePath.Posix (takeBaseName, takeDirectory)
+import Data.Data
+import Data.Typeable
+
+data Theme = Theme {
+  name :: String, -- works better with getHomeDirectory
+  templates :: [(String, Template)]
+    } deriving (Show)
+
+data ProjectConfig = ProjectConfig {
+  name :: Text,
+  description :: Text,
+  theme :: String -- as above
+  } deriving (Show, Data, Typeable)
+
+data Project = Project {
+  name :: Text,
+  description :: Text,
+  theme :: Theme,
+  entries :: EntryList
+  } deriving (Show)
 
 data BlogEntry = BlogEntry {
   postDate :: UTCTime,
@@ -43,13 +65,34 @@ stampsToEntryList stamps = map (\(a,b) -> (a, reverse $ map (\(c,d) -> (c, rever
                            foldl (\c -> \v ->
                                      c ++ [(format (postDate v) "%Y", [(format (postDate v) "%B", v)])]) [] stamps
 
-entryListToPaths :: EntryList -> [Text]
-entryListToPaths el = concat $ concat $ map (\(year, months)
+getEntriesTemplate :: Project -> Template
+getEntriesTemplate p = case lookup "entry.html" $ templates $ theme (p :: Project) of
+  Just a -> a
+
+getEntriesVideoTemplate :: Project -> Template
+getEntriesVideoTemplate p = case lookup "entry-video.html" $ templates $ theme (p :: Project) of
+  Just a -> a
+
+getTemplateForEntry :: Project -> BlogEntry -> Template
+getTemplateForEntry p e = case video e of
+  Just _ -> getEntriesVideoTemplate p
+  Nothing -> getEntriesTemplate p
+
+getIndexTemplate :: Project -> Template
+getIndexTemplate p = case lookup "index.html" $ templates $ theme (p :: Project) of
+  Just a -> a
+
+getEntryPages :: Project -> [(Text, Text)]
+getEntryPages p = concat $ concat $ map (\(year, months)
                                      -> map (\(month, entries)
                                              -> map (\(entryNum, entry) ->
-                                                       year `append`
-                                                       "/" `append`
-                                                       month) entries) months) el
+                                                       (intercalate "/" [
+                                                           "build",
+                                                           format (postDate entry) "%Y",
+                                                           format (postDate entry) "%B",
+                                                           urlify (title entry) `append` ".html"],
+                                                         entryToMarkup entry (getTemplateForEntry p entry))
+                                                    ) entries) months) (entries p)
 
 entryListToIndex :: EntryList -> Text
 entryListToIndex el = unorderedList Nothing $ map (\(year, monthList) -> unorderedList (Just year) $ map (\(month, entryList) -> unorderedList (Just month) $ map (\x -> "<a href=\"" <> year <> "/" <> month <> "/" <> ((urlify . title . snd) x) <>  ".html\">" <> (title . snd) x <> "</a>") entryList) monthList) el
@@ -87,39 +130,25 @@ rawTextToEntry rawEntry = BlogEntry (posixSecondsToUTCTime (fromInteger (read (u
     meta = splitOn "::" (fileLines !! 0)
     fileLines = lines rawEntry
 
-allFilesIn dir = filter (/= "..")<$>(filter(/= "."))<$>(filter(/= ".gitignore"))<$>(getDirectoryContents dir)
-
-exportEntry entry = do
-  rawTemplateNormal <- readFile "templates/entry.html"
-  rawTemplateVideo <- readFile "templates/entry-video.html"
-
-  let entryTemplate = template . pack $ case (video entry) of
-        Nothing -> rawTemplateNormal
-        Just a -> rawTemplateVideo
+allFilesIn dir = filter (/= "..")<$>(filter(/= "."))<$>(getDirectoryContents dir)
 
-  writeFile (unpack $ intercalate "/" [
-                "build",
-                format (postDate entry) "%Y",
-                format (postDate entry) "%B",
-                urlify (title entry) `append` ".html"]) $ unpack $ entryToMarkup entry entryTemplate
-
-exportIndex :: EntryList -> IO()
-exportIndex entryList = do
-  rawTemplate <- readFile "templates/index.html"
-
-  let indexTemplate = template . pack $ rawTemplate
-  let indexContext = context [("index", entryListToIndex entryList)]
-
-  writeFile "build/index.html" $ unpack $ toStrict $ render indexTemplate indexContext
-
-someFunc = do
+someFunc projectConfig files = do
   files <- fmap (reverse . sort) $ allFilesIn "entries"
   rawEntries <- mapM (\x -> (readFile ("entries/" ++ x)) >>= (\y -> (return . fromString) y)) files
   entryList <- mapM (\raw -> return $ rawTextToEntry raw) rawEntries
-  entryPaths <- return $ entryListToPaths $ stampsToEntryList entryList
-  mapM_ (createDirectoryIfMissing True . ("build/" ++) . unpack) entryPaths
-  mapM_ exportEntry entryList
-  exportIndex $ stampsToEntryList entryList
+  homeDir <- getHomeDirectory
+
+  let themeName = theme (projectConfig :: ProjectConfig)
+  themeTemplatePaths <- allFilesIn $ homeDir ++ "/.xyz/themes/" ++ themeName
+  themeTemplates <- mapM (\x -> (readFile $ homeDir ++ "/.xyz/themes/" ++ themeName ++ "/" ++ x) >>= (\y -> return (x, (template . fromString) y))) themeTemplatePaths
+
+  let projectName = name (projectConfig :: ProjectConfig)
+  let projectDescription = description (projectConfig :: ProjectConfig)
+  let project = Project projectName projectDescription (Theme themeName themeTemplates) (stampsToEntryList entryList)
+
+  mapM_ (createDirectoryIfMissing True . takeDirectory . unpack . fst) $ getEntryPages project
+  mapM_ (\x -> writeFile (unpack $ fst x) (unpack $ snd x)) $ getEntryPages project
+  writeFile "build/index.html" $ unpack $ toStrict $ render (getIndexTemplate project) $ context [("index", entryListToIndex (entries project))]
 
 context :: [(Text, Text)] -> Context
 context assocs x = case lookup x $ assocs of