import Data.Tuple.Curry (uncurryN)
import qualified Data.ByteString.Lazy as BL
import Config
+import Control.Exception (catch, IOException)
main :: IO ()
main = getArgs >>= parse
getLocalProjectConfig :: IO (Maybe LocalConfig)
getLocalProjectConfig = doesFileExist "xyz.json" >>= bool (return Nothing) (BL.readFile "xyz.json" >>= return . decode)
+safeReadFile :: FilePath -> IO (Maybe Text)
+safeReadFile p = (Just . pack <$> readFile p) `catch` handler
+ where
+ handler :: IOException -> IO (Maybe Text)
+ handler = const $ pure Nothing
+
+getEntryTemplate :: Text -> IO (Maybe Template)
+getEntryTemplate t = (pure $ fmap template) <*> (safeReadFile =<< ((++ "/entry-" ++ (unpack t) ++ ".txt")) <$> getGlobalProjectDir)
+
resolveProjectConfig :: IO (Either Text ProjectConfig)
resolveProjectConfig = do
l <- getLocalProjectConfig
init = do
home <- getHomeDirectory
themes <- allFilesIn $ home ++ "/.xyz/themes"
- projectSpec <- (initPrompt (map pack themes)) >>= return . fmap snd >>= (\[x,y,z] -> return (x, y, z, Nothing, Nothing, Nothing))
+ projectSpec <- (\[x,y,z] -> (x, y, z, Nothing, Nothing, Nothing)) <$> fmap snd <$> initPrompt (map pack themes)
let localConfig = uncurryN LocalConfig projectSpec
writeFile "xyz.json" (toStrict . encodeToLazyText $ localConfig)
config <- resolveProjectConfig
case (commitCommand (projectConfig :: ProjectConfig), gitRemote (projectConfig :: ProjectConfig)) of
(Just cmd, Just remote) -> do
- mapM_ (callCommand . unpack . ((+++) " > /dev/unll")) ["git init", "git remote add origin " +++ remote, "git add . && git commit -m \"Initial commit\""]
+ putStrLn "Initialising project with git"
+ mapM_ (callCommand . unpack . (+++ " > /dev/null 2>&1")) ["git init", "git remote add origin " +++ remote, "git add .", "git commit -m \"Initial commit\""]
(_, _) -> return()
- putStrLn "\nInitialised empty project"
+ putStrLn "Initialised empty project"
Left error -> do
- putStrLn $ "\n" +++ error
+ putStrLn error
build :: ProjectConfig -> IO ()
build config = allFilesIn "entries" >>= (writeOutProject config) >> putStrLn "Build successful"
entrySpec <- entryPrompt
entryNum <- fmap (show . (+1) . length) $ allFilesIn "entries"
stamp <- fmap (pack . show . round) getPOSIXTime
- videoTemplate <- readFile (homeDir ++ "/.xyz/entry-video.txt") >>= return . template . fromString
- normalTemplate <- readFile (homeDir ++ "/.xyz/entry.txt") >>= return . template . fromString
+ videoTemplate <- getEntryTemplate "video"
+ normalTemplate <- getEntryTemplate "normal"
let rawEntry = case entrySpec of
Just (title, videoSpec) -> do
let baseContext = [("timestamp", stamp), ("title", title)]
case videoSpec of
- Just (videoId, videoFilename) -> (title, toStrict . render videoTemplate $ context $ baseContext ++ [("videoid", videoId), ("videofilename", videoFilename)])
- Nothing -> (title, toStrict . render normalTemplate $ context baseContext)
+ -- TODO: Properly handle the Maybes for video and normal templates
+ Just (videoId, videoFilename) -> (title, toStrict . render (fromJust videoTemplate) $ context $ baseContext ++ [("videoid", videoId), ("videofilename", videoFilename)])
+ Nothing -> (title, toStrict . render (fromJust normalTemplate) $ context baseContext)
let fileName = "entries/" ++ entryNum ++ "-" ++ (unpack . slugify $ fst rawEntry) ++ ".txt"
writeFile fileName $ snd rawEntry
- callCommand $ "nano " ++ fileName
+ callCommand $ (unpack (editor (config :: ProjectConfig))) ++ " " ++ fileName
+ build config
push <- pushPrompt
case push of
- True -> do callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
+ True -> do
+ callCommand . unpack $ "git add . && git commit -m \"" +++ (fst rawEntry) +++ "\" && git push"
False -> return ()
putStrLn "\nThanks for using xyz!"
]
]
-gogogo :: (ProjectConfig -> IO ()) -> Either Text ProjectConfig -> IO ()
-gogogo next projectConfig = case projectConfig of
+continueIfValidProject :: (ProjectConfig -> IO ()) -> Either Text ProjectConfig -> IO ()
+continueIfValidProject next projectConfig = case projectConfig of
Right config -> next config
- Left error -> putStrLn $ "This does not appear to be a vailid project directory: " +++ error -- Never executes, the cases in resolveProjectConfig will fail first.
+ Left error -> putStrLn $ "This does not appear to be a vailid project directory: " +++ error
parse ["init"] = initGlobalIfNeeded (continueIfInvalidProject init) >> exitSuccess
-parse ["build"] = resolveProjectConfig >>= (gogogo build) >> exitSuccess
-parse ["entry"] = resolveProjectConfig >>= (gogogo entry) >> exitSuccess
-parse ["config"] = resolveProjectConfig >>= (gogogo config) >> exitSuccess
+parse ["build"] = resolveProjectConfig >>= (continueIfValidProject build) >> exitSuccess
+parse ["entry"] = resolveProjectConfig >>= (continueIfValidProject entry) >> exitSuccess
+parse ["config"] = resolveProjectConfig >>= (continueIfValidProject config) >> exitSuccess
parse [_] = usage >> exit
parse [] = usage >> exit