import Prelude hiding (init)
import Data.List (intercalate)
import Text.JSON
+import Text.JSON.Generic
import Data.Text hiding (intercalate, unlines, init)
-
-data Project = Project {
- name :: Text,
- description :: Text
- } deriving (Show)
+import System.File.Tree hiding (mapM, mapM_)
+import System.Directory (doesFileExist)
main :: IO ()
main = getArgs >>= parse
init :: IO ()
init = do
- dirExists <- doesDirectoryExist "entries"
+ dirExists <- doesFileExist "xyz.json"
if dirExists
then putStrLn "Project already initialised"
else do createDirectory "entries"
+ home <- getHomeDirectory
+ templates <- allFilesIn $ home ++ "/.xyz/themes"
putStrLn "Enter a name for your project:"
projectName <- getLine
putStrLn "Enter short description for your project:"
projectDescription <- getLine
- writeFile "xyz.json" . encode . toJSObject $ [("name", projectName), ("description", projectDescription), ("theme", "xyz")]
+ putStrLn $ "Which theme would you like to use?\n\n" ++ (ununlines templates)
+ theme <- getLine
+ writeFile "xyz.json" . encode . toJSObject $ [("name", projectName), ("description", projectDescription), ("theme", theme)]
putStrLn "Initialised empty project"
+build :: IO ()
+build = do
+ fileExists <- doesFileExist "xyz.json"
+ if fileExists
+ then do
+ files <- allFilesIn "entries"
+ home <- getHomeDirectory
+ config <- readFile "xyz.json"
+ someFunc (decodeJSON config :: ProjectConfig) files >> putStrLn "Build successful"
+ else putStrLn "This does not appear to be a valid project directory"
ununlines :: [String] -> String
ununlines = intercalate "\n\n"
]
parse ["init"] = init >> exit
-parse ["build"] = someFunc >> exit
+parse ["build"] = build >> exit
parse [_] = usage >> exit
parse [] = usage >> exit
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
module Lib
- ( someFunc
+ ( someFunc, EntryList, allFilesIn, ProjectConfig
) where
import Data.Function (on)
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,
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
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
projects / xyz.git / commitdiff
