1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE TemplateHaskell #-}
3 {-# LANGUAGE DuplicateRecordFields #-}
7 import Data.List (intercalate, zipWith)
8 import Data.String hiding (unlines)
9 import Data.Text hiding (map, init, length, splitAt, foldl, zipWith)
10 import Data.Text.IO (putStrLn, putStr, writeFile)
11 import Data.Text.Lazy (toStrict)
12 import Data.Text.Template
13 import Data.Time.Clock.POSIX
15 import Prelude hiding (putStrLn, putStr, init, unlines, writeFile, zipWith)
17 import System.Directory
18 import System.Directory (doesFileExist)
19 import System.Environment
21 import System.File.Tree hiding (map, mapM, mapM_)
25 import Data.Aeson.Text
28 import Data.Bool (bool)
29 import Data.Tuple.Curry (uncurryN)
30 import qualified Data.ByteString.Lazy as BL
34 main = getArgs >>= parse
36 getGlobalProjectDir :: IO FilePath
37 getGlobalProjectDir = getHomeDirectory >>= return . (++ "/.xyz")
39 getGlobalProjectConfigPath :: IO FilePath
40 getGlobalProjectConfigPath = getGlobalProjectDir >>= return . (++ "/xyz.json")
42 getGlobalProjectConfig :: IO (Maybe GlobalConfig)
43 getGlobalProjectConfig = getGlobalProjectConfigPath >>= (\path -> doesFileExist path >>= bool (return Nothing) (BL.readFile path >>= return . decode))
45 getLocalProjectConfig :: IO (Maybe LocalConfig)
46 getLocalProjectConfig = doesFileExist "xyz.json" >>= bool (return Nothing) (BL.readFile "xyz.json" >>= return . decode)
48 resolveProjectConfig :: IO (Either Text ProjectConfig)
49 resolveProjectConfig = do
50 l <- getLocalProjectConfig
51 g <- getGlobalProjectConfig
53 return $ case (l, g) of
54 (Just l, Just g) -> Right $ getProjectConfig g l
55 (Just _, Nothing) -> Left "Busted global config"
56 (Nothing, Just _) -> Left "Busted local config"
57 _ -> Left "All configs are busted"
59 continueIfInvalidProject :: IO () -> IO ()
60 continueIfInvalidProject next = doesFileExist "xyz.json" >>= bool next (putStrLn "Project already initialised")
62 initGlobalIfNeeded :: IO () -> IO ()
63 initGlobalIfNeeded next = getGlobalProjectConfigPath >>= doesFileExist >>= bool globalInit (return ()) >> next
67 home <- getHomeDirectory
68 putStrLn "\nWelcome to xyz! Looks like this is your first time here. Let's configure a few things...\n"
69 editor <- editorPrompt
71 let pushCmdAndRemote = case vcs of
72 Just (True, x) -> [("pushCommand", "git add . && git commit -m \"$title\""), ("remote", x)]
75 getGlobalProjectConfigPath >>= flip writeFile (toStrict . encodeToLazyText $ GlobalConfig editor (lookup "pushCommand" pushCmdAndRemote) (lookup "remote" pushCmdAndRemote))
76 putStrLn "\nThanks! Now let's continue with initialising your project...\n"
80 home <- getHomeDirectory
81 themes <- allFilesIn $ home ++ "/.xyz/themes"
82 projectSpec <- (initPrompt (map pack themes)) >>= return . fmap snd >>= (\[x,y,z] -> return (x, y, z, Nothing, Nothing, Nothing))
83 let localConfig = uncurryN LocalConfig projectSpec
84 writeFile "xyz.json" (toStrict . encodeToLazyText $ localConfig)
85 config <- resolveProjectConfig
88 Right projectConfig -> do
89 createDirectory "entries"
91 case (commitCommand (projectConfig :: ProjectConfig), gitRemote (projectConfig :: ProjectConfig)) of
92 (Just cmd, Just remote) -> do
93 mapM_ (callCommand . unpack . ((+++) " > /dev/unll")) ["git init", "git remote add origin " +++ remote, "git add . && git commit -m \"Initial commit\""]
96 putStrLn "\nInitialised empty project"
98 putStrLn $ "\n" +++ error
100 build :: ProjectConfig -> IO ()
101 build config = allFilesIn "entries" >>= (writeOutProject config) >> putStrLn "Build successful"
103 entry :: ProjectConfig -> IO ()
105 homeDir <- getHomeDirectory
106 entrySpec <- entryPrompt
107 entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
108 stamp <- fmap (pack . show . round) getPOSIXTime
109 videoTemplate <- readFile (homeDir ++ "/.xyz/entry-video.txt") >>= return . template . fromString
110 normalTemplate <- readFile (homeDir ++ "/.xyz/entry.txt") >>= return . template . fromString
112 let rawEntry = case entrySpec of
113 Just (title, videoSpec) -> do
114 let baseContext = [("timestamp", stamp), ("title", title)]
116 Just (videoId, videoFilename) -> (title, toStrict . render videoTemplate $ context $ baseContext ++ [("videoid", videoId), ("videofilename", videoFilename)])
117 Nothing -> (title, toStrict . render normalTemplate $ context baseContext)
119 let fileName = "entries/" ++ entryNum ++ "-" ++ (unpack . slugify $ fst rawEntry) ++ ".txt"
120 writeFile fileName $ snd rawEntry
122 callCommand $ "nano " ++ fileName
126 True -> do callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
129 putStrLn "\nThanks for using xyz!"
131 config :: ProjectConfig -> IO ()
132 config config = (putStrLn "\nProject details:\n") >> (putStr . unlines $ zipWith (+++) ["Name:\t\t", "Description:\t", "Theme:\t\t", "Editor:\t\t", "Commit command:\t"] [n, d, t, e, ccc]) where
133 n = name (config :: ProjectConfig)
134 d = description (config :: ProjectConfig)
135 t = theme (config :: ProjectConfig)
136 e = editor (config :: ProjectConfig)
137 cc = commitCommand (config :: ProjectConfig)
143 usage = putStr . ununlines $ [
144 "usage: xyz <command>",
145 "Commands:", unlines [
146 "\tinit\t\tInitialise a new site",
147 "\tbuild\t\tBuild the site",
148 "\tentry\t\tInitialise an entry"
152 gogogo :: (ProjectConfig -> IO ()) -> Either Text ProjectConfig -> IO ()
153 gogogo next projectConfig = case projectConfig of
154 Right config -> next config
155 Left error -> putStrLn $ "This does not appear to be a vailid project directory: " +++ error -- Never executes, the cases in resolveProjectConfig will fail first.
157 parse ["init"] = initGlobalIfNeeded (continueIfInvalidProject init) >> exitSuccess
158 parse ["build"] = resolveProjectConfig >>= (gogogo build) >> exitSuccess
159 parse ["entry"] = resolveProjectConfig >>= (gogogo entry) >> exitSuccess
160 parse ["config"] = resolveProjectConfig >>= (gogogo config) >> exitSuccess
161 parse [_] = usage >> exit
162 parse [] = usage >> exit
164 exit = exitWith ExitSuccess