src/Lib.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Lib
   4     ( someFunc
   5     ) where
   6
   7 import Data.Function (on)
   8 import Data.List (sortBy, groupBy)
   9 import Data.Ord (comparing)
  10 import Data.String hiding (lines)
  11 import Data.Text hiding (groupBy, map, concat, foldl, head, splitAt, filter, zip, length, reverse)
  12 import Data.Text.Lazy (toStrict)
  13 import Data.Text.Template
  14 import Data.Time.Clock
  15 import Data.Time.Clock.POSIX
  16 import Data.Time.Format
  17 import Data.Time.LocalTime
  18 import Prelude hiding (lines)
  19 import System.Directory
  20 import System.FilePath.Posix (takeBaseName)
  21
  22 data BlogEntry = BlogEntry {
  23   postDate :: UTCTime,
  24   title :: Text,
  25   body :: Text,
  26   video :: Maybe Text
  27   } deriving (Show)
  28
  29 type EntryList = [(Text, [(Text, [(Text, BlogEntry)])])]
  30
  31 format t format = fromString $ formatTime defaultTimeLocale format $ utcToLocalTime (hoursToTimeZone 8) t
  32
  33 myGroup :: (Eq a, Ord a) => [(a, b)] -> [(a, [b])]
  34 myGroup = map (\l -> (fst . head $ l, map snd l)) . groupBy ((==) `on` fst)
  35
  36 stampsToEntryList :: [BlogEntry] -> EntryList
  37 stampsToEntryList stamps = map (\(a,b) -> (a, reverse $ map (\(c,d) -> (c, map (\(x, y) -> ("0" `append` (fromString . show) x, y)) $ zip [1..] d)) b)) $
  38                            map (\(a, b) -> (a, myGroup b)) $
  39                            map (\(a, b) -> (a, concat b)) $ myGroup $
  40                            foldl (\c -> \v ->
  41                                      c ++ [(format (postDate v) "%Y", [(format (postDate v) "%B", v)])]) [] stamps
  42
  43 entryListToPaths :: EntryList -> [Text]
  44 entryListToPaths el = concat $ concat $ map (\(year, months)
  45                                      -> map (\(month, entries)
  46                                              -> map (\(entryNum, entry) ->
  47                                                        year `append`
  48                                                        "/" `append`
  49                                                        month) entries) months) el
  50
  51 i2t :: Integer -> Text
  52 i2t = (fromString . show)
  53
  54 slugify = toLower. replace " " "-"
  55
  56 timeStampToDateString = fromString . formatTime defaultTimeLocale "%d %B %Y" . utcToLocalTime (hoursToTimeZone 8)
  57
  58 entryToMarkup entry template = toStrict $ render template tmplContext
  59   where
  60     tmplContext = context $ [("title", title entry), ("date", timeStampToDateString $ postDate entry), ("body", body entry)] ++
  61       case video entry of
  62         Nothing -> []
  63         Just a -> [("video", a)]
  64
  65 wrapInTags tag text = intercalate "" $ map ((`append` close) . (open `append`)) text where
  66   close = "</" `append` tag `append` ">"
  67   open = "<" `append` tag `append` ">"
  68
  69 paragraphs = wrapInTags "p"
  70
  71 rawTextToEntry rawEntry = BlogEntry (posixSecondsToUTCTime (fromInteger (read (unpack $ meta !! 0)))) (meta !! 1) (paragraphs (snd (splitAt 1 fileLines))) (lookup 2 metaMap)
  72   where
  73     metaMap = zip [0..] meta
  74     meta = splitOn "::" (fileLines !! 0)
  75     fileLines = lines rawEntry
  76
  77 allFilesIn dir = filter (/= "..")<$>(filter(/= "."))<$>(getDirectoryContents dir)
  78
  79 exportEntry entry = do
  80   rawTemplateNormal <- readFile "templates/entry.html"
  81   rawTemplateVideo <- readFile "templates/entry-video.html"
  82
  83   let entryTemplate = template . pack $ case (video entry) of
  84         Nothing -> rawTemplateNormal
  85         Just a -> rawTemplateVideo
  86
  87   writeFile (unpack $ intercalate "/" [
  88                 "build",
  89                 format (postDate entry) "%Y",
  90                 format (postDate entry) "%B",
  91                 slugify (title entry) `append` ".html"]) $ unpack $ entryToMarkup entry entryTemplate
  92
  93 someFunc = do
  94   files <- allFilesIn "./entries"
  95   rawEntries <- mapM (\x -> (readFile ("entries/" ++ x)) >>= (\y -> (return . fromString) y)) files
  96   entryList <- mapM (\raw -> return $ rawTextToEntry raw) rawEntries
  97   entryPaths <- return $ entryListToPaths $ stampsToEntryList entryList
  98   mapM_ (putStrLn . unpack)  entryPaths
  99   mapM_ (createDirectoryIfMissing True . ("build/" ++) . unpack) entryPaths
 100   mapM_ exportEntry entryList
 101
 102 context :: [(Text, Text)] -> Context
 103 context assocs x = case lookup x $ assocs of
 104                      Nothing -> "lol could not find that " `append` x
 105                      Just a -> a