{-# LANGUAGE OverloadedStrings #-}
module Blog.Wording (
      Wording(..)
    , build
    , variables
  ) where

import Arguments (Arguments(..))
import Control.Monad (foldM)
import Data.Aeson (ToJSON(..))
import Data.Map (Map)
import qualified Data.Map as Map (empty, fromList, keys, map, union)
import Data.Text (Text)
import qualified Data.Text as Text (pack)
import Paths_hablo (getDataFileName)
import Text.ParserCombinators.Parsec (
      Parser
    , (<|>)
    , char, choice, endBy, eof, many, many1, noneOf, optional, parse, string, try
  )
import System.Exit (die)

newtype Wording = Wording (Map String Text)

variables :: Map String [Text]
variables :: Map String [Text]
variables = [(String, [Text])] -> Map String [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
      (String
"allLink", [])
    , (String
"allPage", [Text
"tag"])
    , (String
"articleDescription", [Text
"name"])
    , (String
"commentsLink", [])
    , (String
"commentsSection", [])
    , (String
"dateFormat", [])
    , (String
"latestLink", [])
    , (String
"latestPage", [Text
"tag"])
    , (String
"metadata", [Text
"author", Text
"date", Text
"tags"])
    , (String
"pageDescription", [Text
"name"])
    , (String
"pagesList", [])
    , (String
"rssLink", [])
    , (String
"rssTitle", [Text
"tag"])
    , (String
"tagsList", [])
  ]

instance ToJSON Wording where
  toJSON :: Wording -> Value
toJSON (Wording Map String Text
m) = Map String Text -> Value
forall a. ToJSON a => a -> Value
toJSON Map String Text
m
  toEncoding :: Wording -> Encoding
toEncoding (Wording Map String Text
m) = Map String Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Map String Text
m

addWording :: Map String Text -> FilePath -> IO (Map String Text)
addWording :: Map String Text -> String -> IO (Map String Text)
addWording Map String Text
currentWording String
wordingFile = do
  Either ParseError (Map String Text)
parsed <- Parsec String () (Map String Text)
-> String -> String -> Either ParseError (Map String Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (Map String Text)
wordingP String
wordingFile (String -> Either ParseError (Map String Text))
-> IO String -> IO (Either ParseError (Map String Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
wordingFile
  case Either ParseError (Map String Text)
parsed of
    Left ParseError
errorMessage -> String -> IO (Map String Text)
forall a. String -> IO a
die (String -> IO (Map String Text)) -> String -> IO (Map String Text)
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
errorMessage
    Right Map String Text
newWording -> Map String Text -> IO (Map String Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String Text -> IO (Map String Text))
-> Map String Text -> IO (Map String Text)
forall a b. (a -> b) -> a -> b
$ Map String Text -> Map String Text -> Map String Text
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map String Text
currentWording Map String Text
newWording

wordingP :: Parser (Map String Text)
wordingP :: Parsec String () (Map String Text)
wordingP = (String -> Text) -> Map String String -> Map String Text
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map String -> Text
Text.pack (Map String String -> Map String Text)
-> ([(String, String)] -> Map String String)
-> [(String, String)]
-> Map String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, String)] -> Map String Text)
-> ParsecT String () Identity [(String, String)]
-> Parsec String () (Map String Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (ParsecT String () Identity String
-> ParsecT String () Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity String
forall u. ParsecT String u Identity String
skip ParsecT String () Identity [String]
-> ParsecT String () Identity [(String, String)]
-> ParsecT String () Identity [(String, String)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity (String, String)
forall u. ParsecT String u Identity (String, String)
line ParsecT String () Identity (String, String)
-> ParsecT String () Identity [String]
-> ParsecT String () Identity [(String, String)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`endBy` (ParsecT String () Identity String
-> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity String
forall u. ParsecT String u Identity String
skip) ParsecT String () Identity [(String, String)]
-> ParsecT String () Identity ()
-> ParsecT String () Identity [(String, String)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  where
    restOfLine :: ParsecT String u Identity String
restOfLine = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\r\n"
    eol :: ParsecT String u Identity String
eol = ParsecT String u Identity String
-> ParsecT String u Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r\n") ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r" ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\n"
    skip :: ParsecT String u Identity String
skip = ParsecT String u Identity String -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u Identity String
forall u. ParsecT String u Identity String
restOfLine) ParsecT String u Identity ()
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u Identity String
forall u. ParsecT String u Identity String
eol
    varEqual :: ParsecT String u Identity String
varEqual = [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (ParsecT String u Identity String
-> ParsecT String u Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> (String -> ParsecT String u Identity String)
-> String
-> ParsecT String u Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String -> ParsecT String u Identity String)
-> [String] -> [ParsecT String u Identity String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String [Text] -> [String]
forall k a. Map k a -> [k]
Map.keys Map String [Text]
variables) ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity String
forall u. ParsecT String u Identity String
equal
    line :: ParsecT String u Identity (String, String)
line = (,) (String -> String -> (String, String))
-> ParsecT String u Identity String
-> ParsecT String u Identity (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity String
forall u. ParsecT String u Identity String
varEqual ParsecT String u Identity (String -> (String, String))
-> ParsecT String u Identity String
-> ParsecT String u Identity (String, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String u Identity String
forall u. ParsecT String u Identity String
restOfLine
    equal :: ParsecT String u Identity String
equal = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') ParsecT String u Identity String
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')

build :: Arguments -> IO Wording
build :: Arguments -> IO Wording
build Arguments
arguments = do
  String
defaultWording <- String -> IO String
getDataFileName String
"defaultWording.conf"
  let wordingFiles :: [String]
wordingFiles = ([String] -> [String])
-> (String -> [String] -> [String])
-> Maybe String
-> [String]
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String] -> [String]
forall a. a -> a
id (:) (Arguments -> Maybe String
wording Arguments
arguments) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String
defaultWording]
  Map String Text -> Wording
Wording (Map String Text -> Wording) -> IO (Map String Text) -> IO Wording
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map String Text -> String -> IO (Map String Text))
-> Map String Text -> [String] -> IO (Map String Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map String Text -> String -> IO (Map String Text)
addWording Map String Text
forall k a. Map k a
Map.empty [String]
wordingFiles