{-# LANGUAGE NamedFieldPuns #-}
module Article (
      Article(..)
    , at
    , preview
  ) where

import Control.Applicative ((<|>))
import qualified Data.Map as Map (alter)
import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Foreign.C.Types (CTime)
import Markdown (Markdown(..), MarkdownContent(..), Metadata)
import qualified Markdown (at)
import System.Posix.Files (getFileStatus, modificationTime)
import Text.ParserCombinators.Parsec (ParseError)

newtype Article = Article Markdown
instance MarkdownContent Article where
  getMarkdown :: Article -> Markdown
getMarkdown (Article Markdown
markdown) = Markdown
markdown

setDate :: String -> CTime -> Metadata -> Metadata
setDate :: String -> CTime -> Metadata -> Metadata
setDate String
tzOffset CTime
defaultDate = (Maybe String -> Maybe String) -> String -> Metadata -> Metadata
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe String -> Maybe String
timeStamp String
"date"
  where
    formats :: [String]
formats = (String
"%Y-%m-%d" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" %z") (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"", String
" %H:%M"]
    epoch :: UTCTime -> String
epoch = Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (UTCTime -> Integer) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate :: POSIXTime -> Integer) (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
    timeStamp :: Maybe String -> Maybe String
timeStamp Maybe String
Nothing = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ CTime -> String
forall a. Show a => a -> String
show CTime
defaultDate
    timeStamp (Just String
date) =
      let dates :: [String]
dates = [String
date, String
date String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tzOffset] in
      let parsedTimes :: [Maybe UTCTime]
parsedTimes = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale (String -> String -> Maybe UTCTime)
-> [String] -> [String -> Maybe UTCTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
formats [String -> Maybe UTCTime] -> [String] -> [Maybe UTCTime]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String]
dates in
      (Maybe String -> Maybe String -> Maybe String)
-> Maybe String -> [Maybe String] -> Maybe String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe String -> Maybe String
timeStamp Maybe String
forall a. Maybe a
Nothing) ((UTCTime -> String) -> Maybe UTCTime -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> String
epoch (Maybe UTCTime -> Maybe String)
-> [Maybe UTCTime] -> [Maybe String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe UTCTime]
parsedTimes)

makeArticle :: (Metadata -> Metadata) -> Markdown -> (String, Article)
makeArticle :: (Metadata -> Metadata) -> Markdown -> (String, Article)
makeArticle Metadata -> Metadata
metaFilter markdown :: Markdown
markdown@(Markdown {String
key :: Markdown -> String
key :: String
key, Metadata
metadata :: Markdown -> Metadata
metadata :: Metadata
metadata}) =
  (String
key, Markdown -> Article
Article (Markdown -> Article) -> Markdown -> Article
forall a b. (a -> b) -> a -> b
$ Markdown
markdown {metadata :: Metadata
metadata = Metadata -> Metadata
metaFilter Metadata
metadata})

at :: FilePath -> IO (Either ParseError (String, Article))
at :: String -> IO (Either ParseError (String, Article))
at String
filePath = do
  String
tzOffset <- TimeZone -> String
timeZoneOffsetString (TimeZone -> String) -> IO TimeZone -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeZone
getCurrentTimeZone
  CTime
fileDate <- FileStatus -> CTime
modificationTime (FileStatus -> CTime) -> IO FileStatus -> IO CTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
filePath
  (Markdown -> (String, Article))
-> Either ParseError Markdown
-> Either ParseError (String, Article)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Metadata -> Metadata) -> Markdown -> (String, Article)
makeArticle (String -> CTime -> Metadata -> Metadata
setDate String
tzOffset CTime
fileDate)) (Either ParseError Markdown -> Either ParseError (String, Article))
-> IO (Either ParseError Markdown)
-> IO (Either ParseError (String, Article))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either ParseError Markdown)
Markdown.at String
filePath

preview :: Int -> Article -> Markdown
preview :: Int -> Article -> Markdown
preview Int
linesCount (Article markdown :: Markdown
markdown@(Markdown {[String]
body :: Markdown -> [String]
body :: [String]
body})) =
  Markdown
markdown {body :: [String]
body = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
linesCount ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
body}