{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
module Text.BlogLiterately.Transform
(
standardTransforms
, optionsXF
, profileXF
, highlightOptsXF
, passwordXF
, titleXF
, rawtexifyXF
, wptexifyXF
, ghciXF
, uploadImagesXF
, highlightXF
, centerImagesXF
, citationsXF
, specialLinksXF
, mkSpecialLinksXF
, standardSpecialLinks
, luckyLink
, wikiLink
, postLink
, Transform(..), pureTransform, ioTransform, runTransform, runTransforms
, xformDoc
, fixLineEndings
) where
import Control.Applicative ((<$>))
import Control.Arrow ((>>>))
import Control.Lens (has, isn't, use, (%=), (&),
(.=), (.~), (^.), _1, _2,
_Just)
import Control.Monad.State
import Data.Char (isDigit, toLower)
import Data.List (intercalate, isInfixOf,
isPrefixOf)
import Data.List.Split (splitOn)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Monoid (mappend)
import Data.Monoid (mempty, (<>))
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Traversable (traverse)
import Network.HTTP (getRequest, getResponseBody,
simpleHTTP)
import System.Directory (doesFileExist,
getAppUserDataDirectory)
import System.Exit (exitFailure)
import System.FilePath (takeExtension, (<.>), (</>))
import System.IO (hFlush, stdout)
import Text.Blaze.Html.Renderer.String (renderHtml)
import Text.CSL.Pandoc (processCites')
import Text.HTML.TagSoup
import Text.Pandoc hiding (openURL)
import Text.Pandoc.Error (PandocError)
import Text.Parsec (ParseError)
import Text.BlogLiterately.Block (onTag)
import Text.BlogLiterately.Ghci (formatInlineGhci)
import Text.BlogLiterately.Highlight (HsHighlight (HsColourInline),
colourisePandoc,
getStylePrefs,
_HsColourInline)
import Text.BlogLiterately.Image (uploadAllImages)
import Text.BlogLiterately.LaTeX (rawTeXify, wpTeXify)
import Text.BlogLiterately.Options
import Text.BlogLiterately.Options.Parse (readBLOptions)
import Text.BlogLiterately.Post (findTitle, getPostURL)
data Transform = Transform
{ Transform -> StateT (BlogLiterately, Pandoc) IO ()
getTransform :: StateT (BlogLiterately, Pandoc) IO ()
, Transform -> BlogLiterately -> Bool
xfCond :: BlogLiterately -> Bool
}
pureTransform :: (BlogLiterately -> Pandoc -> Pandoc)
-> (BlogLiterately -> Bool) -> Transform
pureTransform :: (BlogLiterately -> Pandoc -> Pandoc)
-> (BlogLiterately -> Bool) -> Transform
pureTransform transf :: BlogLiterately -> Pandoc -> Pandoc
transf cond :: BlogLiterately -> Bool
cond = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately -> Bool) -> Transform
Transform (((BlogLiterately, Pandoc) -> BlogLiterately)
-> StateT (BlogLiterately, Pandoc) IO BlogLiterately
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BlogLiterately, Pandoc) -> BlogLiterately
forall a b. (a, b) -> a
fst StateT (BlogLiterately, Pandoc) IO BlogLiterately
-> (BlogLiterately -> StateT (BlogLiterately, Pandoc) IO ())
-> StateT (BlogLiterately, Pandoc) IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \bl :: BlogLiterately
bl -> (Pandoc -> Identity Pandoc)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Pandoc -> Identity Pandoc)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> (Pandoc -> Pandoc) -> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BlogLiterately -> Pandoc -> Pandoc
transf BlogLiterately
bl) BlogLiterately -> Bool
cond
ioTransform :: (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform :: (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform transf :: BlogLiterately -> Pandoc -> IO Pandoc
transf cond :: BlogLiterately -> Bool
cond = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately -> Bool) -> Transform
Transform (((BlogLiterately, Pandoc) -> IO ((), (BlogLiterately, Pandoc)))
-> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (((BlogLiterately, Pandoc) -> IO ((), (BlogLiterately, Pandoc)))
-> StateT (BlogLiterately, Pandoc) IO ())
-> (((BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc))
-> (BlogLiterately, Pandoc) -> IO ((), (BlogLiterately, Pandoc)))
-> ((BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc))
-> StateT (BlogLiterately, Pandoc) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO (BlogLiterately, Pandoc) -> IO ((), (BlogLiterately, Pandoc)))
-> ((BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc))
-> (BlogLiterately, Pandoc)
-> IO ((), (BlogLiterately, Pandoc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((BlogLiterately, Pandoc) -> ((), (BlogLiterately, Pandoc)))
-> IO (BlogLiterately, Pandoc) -> IO ((), (BlogLiterately, Pandoc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((BlogLiterately, Pandoc) -> ((), (BlogLiterately, Pandoc)))
-> IO (BlogLiterately, Pandoc)
-> IO ((), (BlogLiterately, Pandoc)))
-> ((BlogLiterately, Pandoc) -> ((), (BlogLiterately, Pandoc)))
-> IO (BlogLiterately, Pandoc)
-> IO ((), (BlogLiterately, Pandoc))
forall a b. (a -> b) -> a -> b
$ (,) ()) (((BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc))
-> StateT (BlogLiterately, Pandoc) IO ())
-> ((BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc))
-> StateT (BlogLiterately, Pandoc) IO ()
forall a b. (a -> b) -> a -> b
$ (BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc)
transf') BlogLiterately -> Bool
cond
where transf' :: (BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc)
transf' (bl :: BlogLiterately
bl,p :: Pandoc
p) = ((,) BlogLiterately
bl) (Pandoc -> (BlogLiterately, Pandoc))
-> IO Pandoc -> IO (BlogLiterately, Pandoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlogLiterately -> Pandoc -> IO Pandoc
transf BlogLiterately
bl Pandoc
p
runTransform :: Transform -> StateT (BlogLiterately, Pandoc) IO ()
runTransform :: Transform -> StateT (BlogLiterately, Pandoc) IO ()
runTransform t :: Transform
t = do
BlogLiterately
bl <- ((BlogLiterately, Pandoc) -> BlogLiterately)
-> StateT (BlogLiterately, Pandoc) IO BlogLiterately
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BlogLiterately, Pandoc) -> BlogLiterately
forall a b. (a, b) -> a
fst
Bool
-> StateT (BlogLiterately, Pandoc) IO ()
-> StateT (BlogLiterately, Pandoc) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Transform -> BlogLiterately -> Bool
xfCond Transform
t BlogLiterately
bl) (StateT (BlogLiterately, Pandoc) IO ()
-> StateT (BlogLiterately, Pandoc) IO ())
-> StateT (BlogLiterately, Pandoc) IO ()
-> StateT (BlogLiterately, Pandoc) IO ()
forall a b. (a -> b) -> a -> b
$ Transform -> StateT (BlogLiterately, Pandoc) IO ()
getTransform Transform
t
runTransforms :: [Transform] -> BlogLiterately -> Pandoc -> IO (BlogLiterately, Pandoc)
runTransforms :: [Transform]
-> BlogLiterately -> Pandoc -> IO (BlogLiterately, Pandoc)
runTransforms ts :: [Transform]
ts bl :: BlogLiterately
bl p :: Pandoc
p = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately, Pandoc) -> IO (BlogLiterately, Pandoc)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((Transform -> StateT (BlogLiterately, Pandoc) IO ())
-> [Transform] -> StateT (BlogLiterately, Pandoc) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Transform -> StateT (BlogLiterately, Pandoc) IO ()
runTransform [Transform]
ts) (BlogLiterately
bl,Pandoc
p)
rawtexifyXF :: Transform
rawtexifyXF :: Transform
rawtexifyXF = (BlogLiterately -> Pandoc -> Pandoc)
-> (BlogLiterately -> Bool) -> Transform
pureTransform ((Pandoc -> Pandoc) -> BlogLiterately -> Pandoc -> Pandoc
forall a b. a -> b -> a
const Pandoc -> Pandoc
rawTeXify) BlogLiterately -> Bool
rawlatex'
wptexifyXF :: Transform
wptexifyXF :: Transform
wptexifyXF = (BlogLiterately -> Pandoc -> Pandoc)
-> (BlogLiterately -> Bool) -> Transform
pureTransform ((Pandoc -> Pandoc) -> BlogLiterately -> Pandoc -> Pandoc
forall a b. a -> b -> a
const Pandoc -> Pandoc
wpTeXify) BlogLiterately -> Bool
wplatex'
ghciXF :: Transform
ghciXF :: Transform
ghciXF = (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform (FilePath -> Pandoc -> IO Pandoc
formatInlineGhci (FilePath -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> FilePath)
-> BlogLiterately
-> Pandoc
-> IO Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogLiterately -> FilePath
file') BlogLiterately -> Bool
ghci'
uploadImagesXF :: Transform
uploadImagesXF :: Transform
uploadImagesXF = (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform BlogLiterately -> Pandoc -> IO Pandoc
uploadAllImages BlogLiterately -> Bool
uploadImages'
highlightXF :: Transform
highlightXF :: Transform
highlightXF = (BlogLiterately -> Pandoc -> Pandoc)
-> (BlogLiterately -> Bool) -> Transform
pureTransform
(\bl :: BlogLiterately
bl -> HsHighlight -> Bool -> Pandoc -> Pandoc
colourisePandoc (BlogLiterately -> HsHighlight
hsHighlight' BlogLiterately
bl) (BlogLiterately -> Bool
otherHighlight' BlogLiterately
bl))
(Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)
centerImagesXF :: Transform
centerImagesXF :: Transform
centerImagesXF = (BlogLiterately -> Pandoc -> Pandoc)
-> (BlogLiterately -> Bool) -> Transform
pureTransform ((Pandoc -> Pandoc) -> BlogLiterately -> Pandoc -> Pandoc
forall a b. a -> b -> a
const Pandoc -> Pandoc
centerImages) (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)
centerImages :: Pandoc -> Pandoc
centerImages :: Pandoc -> Pandoc
centerImages = ([Block] -> [Block]) -> Pandoc -> Pandoc
forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Block] -> [Block]
centerImage
where
centerImage :: [Block] -> [Block]
centerImage :: [Block] -> [Block]
centerImage (img :: Block
img@(Para [Image _attr :: Attr
_attr _altText :: [Inline]
_altText (_imgUrl :: Text
_imgUrl, _imgTitle :: Text
_imgTitle)]) : bs :: [Block]
bs) =
Format -> Text -> Block
RawBlock (Text -> Format
Format "html") "<div style=\"text-align: center;\">"
Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Block
img
Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Format -> Text -> Block
RawBlock (Text -> Format
Format "html") "</div>"
Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs
centerImage bs :: [Block]
bs = [Block]
bs
specialLinksXF :: Transform
specialLinksXF :: Transform
specialLinksXF = [SpecialLink] -> Transform
mkSpecialLinksXF [SpecialLink]
standardSpecialLinks
standardSpecialLinks :: [SpecialLink]
standardSpecialLinks :: [SpecialLink]
standardSpecialLinks =
[ SpecialLink
luckyLink
, SpecialLink
wikiLink
, SpecialLink
postLink
, SpecialLink
githubLink
, SpecialLink
hackageLink
]
type SpecialLink = (Text, Text -> BlogLiterately -> IO Text)
mkSpecialLinksXF :: [SpecialLink] -> Transform
mkSpecialLinksXF :: [SpecialLink] -> Transform
mkSpecialLinksXF links :: [SpecialLink]
links = (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform ([SpecialLink] -> BlogLiterately -> Pandoc -> IO Pandoc
specialLinks [SpecialLink]
links) (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)
specialLinks :: [SpecialLink] -> BlogLiterately -> Pandoc -> IO Pandoc
specialLinks :: [SpecialLink] -> BlogLiterately -> Pandoc -> IO Pandoc
specialLinks links :: [SpecialLink]
links bl :: BlogLiterately
bl = (Inline -> IO Inline) -> Pandoc -> IO Pandoc
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
bottomUpM Inline -> IO Inline
specialLink
where
specialLink :: Inline -> IO Inline
specialLink :: Inline -> IO Inline
specialLink i :: Inline
i@(Link attrs :: Attr
attrs alt :: [Inline]
alt (url :: Text
url, title :: Text
title))
| Just (typ :: Text
typ, target :: Text
target) <- Text -> Maybe (Text, Text)
getSpecial Text
url
= Text -> Inline
mkLink (Text -> Inline) -> IO Text -> IO Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text -> [SpecialLink] -> Maybe (Text -> BlogLiterately -> IO Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower Text
typ) [SpecialLink]
links of
Just mkURL :: Text -> BlogLiterately -> IO Text
mkURL -> Text -> BlogLiterately -> IO Text
mkURL Text
target BlogLiterately
bl
Nothing -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
target
where
mkLink :: Text -> Inline
mkLink u :: Text
u = Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attrs [Inline]
alt (Text
u, Text
title)
specialLink i :: Inline
i = Inline -> IO Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
i
getSpecial :: Text -> Maybe (Text, Text)
getSpecial url :: Text
url
| "::" Text -> Text -> Bool
`T.isInfixOf` Text
url =
let (typ :: Text
typ:rest :: [Text]
rest) = Text -> Text -> [Text]
T.splitOn "::" Text
url
in (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
typ, Text -> [Text] -> Text
T.intercalate "::" [Text]
rest)
| Bool
otherwise = Maybe (Text, Text)
forall a. Maybe a
Nothing
luckyLink :: SpecialLink
luckyLink :: SpecialLink
luckyLink = ("lucky", Text -> BlogLiterately -> IO Text
getLucky)
where
getLucky :: Text -> BlogLiterately -> IO Text
getLucky :: Text -> BlogLiterately -> IO Text
getLucky searchTerm :: Text
searchTerm _ = do
FilePath
results <- FilePath -> IO FilePath
openURL (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ "http://www.google.com/search?q=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Text -> FilePath
T.unpack Text
searchTerm)
let tags :: [Tag FilePath]
tags = FilePath -> [Tag FilePath]
forall str. StringLike str => str -> [Tag str]
parseTags FilePath
results
anchor :: [Tag FilePath]
anchor = Int -> [Tag FilePath] -> [Tag FilePath]
forall a. Int -> [a] -> [a]
take 1
([Tag FilePath] -> [Tag FilePath])
-> ([Tag FilePath] -> [Tag FilePath])
-> [Tag FilePath]
-> [Tag FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag FilePath -> Bool) -> [Tag FilePath] -> [Tag FilePath]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Tag FilePath -> FilePath -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~/= ("<a>" :: String))
([Tag FilePath] -> [Tag FilePath])
-> ([Tag FilePath] -> [Tag FilePath])
-> [Tag FilePath]
-> [Tag FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag FilePath -> Bool) -> [Tag FilePath] -> [Tag FilePath]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Tag FilePath -> FilePath -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~/= ("<h3 class='r'>" :: String))
([Tag FilePath] -> [Tag FilePath])
-> [Tag FilePath] -> [Tag FilePath]
forall a b. (a -> b) -> a -> b
$ [Tag FilePath]
tags
url :: Text
url = case [Tag FilePath]
anchor of
[t :: Tag FilePath
t@(TagOpen{})] -> FilePath -> Text
T.pack (FilePath -> Text)
-> (Tag FilePath -> FilePath) -> Tag FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='&') (FilePath -> FilePath)
-> (Tag FilePath -> FilePath) -> Tag FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='h') (FilePath -> FilePath)
-> (Tag FilePath -> FilePath) -> Tag FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Tag FilePath -> FilePath
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib "href" (Tag FilePath -> Text) -> Tag FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Tag FilePath
t
_ -> Text
searchTerm
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
url
openURL :: String -> IO String
openURL :: FilePath -> IO FilePath
openURL x :: FilePath
x = Result (Response FilePath) -> IO FilePath
forall ty. Result (Response ty) -> IO ty
getResponseBody (Result (Response FilePath) -> IO FilePath)
-> IO (Result (Response FilePath)) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Request FilePath -> IO (Result (Response FilePath))
forall ty. HStream ty => Request ty -> IO (Result (Response ty))
simpleHTTP (FilePath -> Request FilePath
getRequest FilePath
x)
wikiLink :: SpecialLink
wikiLink :: SpecialLink
wikiLink = ("wiki", \target :: Text
target _ -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append "https://en.wikipedia.org/wiki/" Text
target)
postLink :: SpecialLink
postLink :: SpecialLink
postLink = ("post", Text -> BlogLiterately -> IO Text
getPostLink)
where
getPostLink :: Text -> BlogLiterately -> IO Text
getPostLink :: Text -> BlogLiterately -> IO Text
getPostLink target :: Text
target bl :: BlogLiterately
bl =
(Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
target (Maybe Text -> Text)
-> (Maybe FilePath -> Maybe Text) -> Maybe FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack) (Maybe FilePath -> Text) -> IO (Maybe FilePath) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
case ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
target, BlogLiterately
bl BlogLiterately
-> Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
Lens' BlogLiterately (Maybe FilePath)
blog) of
(_ , Nothing ) -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
(True , Just url :: FilePath
url) -> FilePath -> FilePath -> FilePath -> FilePath -> IO (Maybe FilePath)
getPostURL FilePath
url (Text -> FilePath
T.unpack Text
target) (BlogLiterately -> FilePath
user' BlogLiterately
bl) (BlogLiterately -> FilePath
password' BlogLiterately
bl)
(False, Just url :: FilePath
url) -> Int
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Maybe FilePath)
findTitle 20 FilePath
url (Text -> FilePath
T.unpack Text
target) (BlogLiterately -> FilePath
user' BlogLiterately
bl) (BlogLiterately -> FilePath
password' BlogLiterately
bl)
githubLink :: SpecialLink
githubLink :: SpecialLink
githubLink = ("github", Text -> BlogLiterately -> IO Text
getGithubLink)
where
getGithubLink :: Text -> BlogLiterately -> IO Text
getGithubLink :: Text -> BlogLiterately -> IO Text
getGithubLink target :: Text
target bl :: BlogLiterately
bl = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> (FilePath -> Text) -> FilePath -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> IO Text) -> FilePath -> IO Text
forall a b. (a -> b) -> a -> b
$
case FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn "/" (Text -> FilePath
T.unpack Text
target) of
(user :: FilePath
user : repo :: FilePath
repo : ghTarget :: [FilePath]
ghTarget) -> FilePath
github FilePath -> FilePath -> FilePath
</> FilePath
user FilePath -> FilePath -> FilePath
</> FilePath
repo FilePath -> FilePath -> FilePath
</> [FilePath] -> FilePath
mkTarget [FilePath]
ghTarget
_ -> FilePath
github FilePath -> FilePath -> FilePath
</> (Text -> FilePath
T.unpack Text
target)
github :: FilePath
github = "https://github.com/"
mkTarget :: [FilePath] -> FilePath
mkTarget [] = ""
mkTarget (('@': hash :: FilePath
hash) : _) = "commit" FilePath -> FilePath -> FilePath
</> FilePath
hash
mkTarget (('#': issue :: FilePath
issue) : _) = "issues" FilePath -> FilePath -> FilePath
</> FilePath
issue
hackageLink :: SpecialLink
hackageLink :: SpecialLink
hackageLink = ("hackage", Text -> BlogLiterately -> IO Text
getHackageLink)
where
getHackageLink :: Text -> BlogLiterately -> IO Text
getHackageLink :: Text -> BlogLiterately -> IO Text
getHackageLink pkg :: Text
pkg bl :: BlogLiterately
bl = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
hackagePrefix Text
pkg
hackagePrefix :: Text
hackagePrefix = "http://hackage.haskell.org/package/"
titleXF :: Transform
titleXF :: Transform
titleXF = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately -> Bool) -> Transform
Transform StateT (BlogLiterately, Pandoc) IO ()
extractTitle (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)
where
extractTitle :: StateT (BlogLiterately, Pandoc) IO ()
extractTitle = do
(Pandoc (Meta m :: Map Text MetaValue
m) _) <- ((BlogLiterately, Pandoc) -> Pandoc)
-> StateT (BlogLiterately, Pandoc) IO Pandoc
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BlogLiterately, Pandoc) -> Pandoc
forall a b. (a, b) -> b
snd
case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "title" Map Text MetaValue
m of
Just (MetaString s :: Text
s) ->
FilePath -> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *).
(MonadState s m, Field1 s s BlogLiterately BlogLiterately) =>
FilePath -> m ()
setTitle (Text -> FilePath
T.unpack Text
s)
Just (MetaInlines is :: [Inline]
is) ->
FilePath -> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *).
(MonadState s m, Field1 s s BlogLiterately BlogLiterately) =>
FilePath -> m ()
setTitle (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate " " [Text -> FilePath
T.unpack Text
s | Str s :: Text
s <- [Inline]
is])
_ -> () -> StateT (BlogLiterately, Pandoc) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setTitle :: FilePath -> m ()
setTitle s :: FilePath
s = (BlogLiterately -> Identity BlogLiterately) -> s -> Identity s
forall s t a b. Field1 s t a b => Lens s t a b
_1((BlogLiterately -> Identity BlogLiterately) -> s -> Identity s)
-> ((Maybe FilePath -> Identity (Maybe FilePath))
-> BlogLiterately -> Identity BlogLiterately)
-> (Maybe FilePath -> Identity (Maybe FilePath))
-> s
-> Identity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe FilePath -> Identity (Maybe FilePath))
-> BlogLiterately -> Identity BlogLiterately
Lens' BlogLiterately (Maybe FilePath)
title ((Maybe FilePath -> Identity (Maybe FilePath)) -> s -> Identity s)
-> (Maybe FilePath -> Maybe FilePath) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
s)
optionsXF :: Transform
optionsXF :: Transform
optionsXF = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately -> Bool) -> Transform
Transform StateT (BlogLiterately, Pandoc) IO ()
optionsXF' (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)
where
optionsXF' :: StateT (BlogLiterately, Pandoc) IO ()
optionsXF' = do
(errs :: [ParseError]
errs, opts :: BlogLiterately
opts) <- (Block -> ([ParseError], BlogLiterately))
-> Pandoc -> ([ParseError], BlogLiterately)
forall a b c. (Data a, Monoid b, Data c) => (a -> b) -> c -> b
queryWith Block -> ([ParseError], BlogLiterately)
extractOptions (Pandoc -> ([ParseError], BlogLiterately))
-> StateT (BlogLiterately, Pandoc) IO Pandoc
-> StateT
(BlogLiterately, Pandoc) IO ([ParseError], BlogLiterately)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((BlogLiterately, Pandoc) -> Pandoc)
-> StateT (BlogLiterately, Pandoc) IO Pandoc
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BlogLiterately, Pandoc) -> Pandoc
forall a b. (a, b) -> b
snd
(ParseError -> StateT (BlogLiterately, Pandoc) IO ())
-> [ParseError] -> StateT (BlogLiterately, Pandoc) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> StateT (BlogLiterately, Pandoc) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT (BlogLiterately, Pandoc) IO ())
-> (ParseError -> IO ())
-> ParseError
-> StateT (BlogLiterately, Pandoc) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> IO ()
forall a. Show a => a -> IO ()
print) [ParseError]
errs
(BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> (BlogLiterately -> BlogLiterately)
-> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (BlogLiterately -> BlogLiterately -> BlogLiterately
forall a. Semigroup a => a -> a -> a
<> BlogLiterately
opts)
(Pandoc -> Identity Pandoc)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Pandoc -> Identity Pandoc)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> (Pandoc -> Pandoc) -> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Block -> Block) -> Pandoc -> Pandoc
forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp Block -> Block
killOptionBlocks
extractOptions :: Block -> ([ParseError], BlogLiterately)
= Text
-> (Attr -> Text -> ([ParseError], BlogLiterately))
-> (Block -> ([ParseError], BlogLiterately))
-> Block
-> ([ParseError], BlogLiterately)
forall a. Text -> (Attr -> Text -> a) -> (Block -> a) -> Block -> a
onTag "blopts" ((Text -> ([ParseError], BlogLiterately))
-> Attr -> Text -> ([ParseError], BlogLiterately)
forall a b. a -> b -> a
const (FilePath -> ([ParseError], BlogLiterately)
readBLOptions (FilePath -> ([ParseError], BlogLiterately))
-> (Text -> FilePath) -> Text -> ([ParseError], BlogLiterately)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)) (([ParseError], BlogLiterately)
-> Block -> ([ParseError], BlogLiterately)
forall a b. a -> b -> a
const ([ParseError], BlogLiterately)
forall a. Monoid a => a
mempty)
killOptionBlocks :: Block -> Block
killOptionBlocks :: Block -> Block
killOptionBlocks = Text
-> (Attr -> Text -> Block) -> (Block -> Block) -> Block -> Block
forall a. Text -> (Attr -> Text -> a) -> (Block -> a) -> Block -> a
onTag "blopts" ((Text -> Block) -> Attr -> Text -> Block
forall a b. a -> b -> a
const (Block -> Text -> Block
forall a b. a -> b -> a
const Block
Null)) Block -> Block
forall a. a -> a
id
passwordXF :: Transform
passwordXF :: Transform
passwordXF = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately -> Bool) -> Transform
Transform StateT (BlogLiterately, Pandoc) IO ()
passwordPrompt BlogLiterately -> Bool
passwordCond
where
passwordCond :: BlogLiterately -> Bool
passwordCond bl :: BlogLiterately
bl = ((BlogLiterately
bl BlogLiterately
-> Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
Lens' BlogLiterately (Maybe FilePath)
blog) Maybe FilePath -> (Maybe FilePath -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Getting Any (Maybe FilePath) FilePath -> Maybe FilePath -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any (Maybe FilePath) FilePath
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
Bool -> Bool -> Bool
&& ((BlogLiterately
bl BlogLiterately
-> Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
Lens' BlogLiterately (Maybe FilePath)
password) Maybe FilePath -> (Maybe FilePath -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& APrism (Maybe FilePath) (Maybe Any) FilePath Any
-> Maybe FilePath -> Bool
forall s t a b. APrism s t a b -> s -> Bool
isn't APrism (Maybe FilePath) (Maybe Any) FilePath Any
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
passwordPrompt :: StateT (BlogLiterately, Pandoc) IO ()
passwordPrompt = do
IO () -> StateT (BlogLiterately, Pandoc) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT (BlogLiterately, Pandoc) IO ())
-> IO () -> StateT (BlogLiterately, Pandoc) IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr "Password: " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout
FilePath
pwd <- IO FilePath -> StateT (BlogLiterately, Pandoc) IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getLine
(BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> ((Maybe FilePath -> Identity (Maybe FilePath))
-> BlogLiterately -> Identity BlogLiterately)
-> (Maybe FilePath -> Identity (Maybe FilePath))
-> (BlogLiterately, Pandoc)
-> Identity (BlogLiterately, Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> Identity (Maybe FilePath))
-> BlogLiterately -> Identity BlogLiterately
Lens' BlogLiterately (Maybe FilePath)
password ((Maybe FilePath -> Identity (Maybe FilePath))
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> Maybe FilePath -> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
pwd
highlightOptsXF :: Transform
highlightOptsXF :: Transform
highlightOptsXF = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately -> Bool) -> Transform
Transform StateT (BlogLiterately, Pandoc) IO ()
doHighlightOptsXF (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)
where
doHighlightOptsXF :: StateT (BlogLiterately, Pandoc) IO ()
doHighlightOptsXF = do
StylePrefs
prefs <- (IO StylePrefs -> StateT (BlogLiterately, Pandoc) IO StylePrefs
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StylePrefs -> StateT (BlogLiterately, Pandoc) IO StylePrefs)
-> (Maybe FilePath -> IO StylePrefs)
-> Maybe FilePath
-> StateT (BlogLiterately, Pandoc) IO StylePrefs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> IO StylePrefs
getStylePrefs) (Maybe FilePath -> StateT (BlogLiterately, Pandoc) IO StylePrefs)
-> StateT (BlogLiterately, Pandoc) IO (Maybe FilePath)
-> StateT (BlogLiterately, Pandoc) IO StylePrefs
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting (Maybe FilePath) (BlogLiterately, Pandoc) (Maybe FilePath)
-> StateT (BlogLiterately, Pandoc) IO (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((BlogLiterately -> Const (Maybe FilePath) BlogLiterately)
-> (BlogLiterately, Pandoc)
-> Const (Maybe FilePath) (BlogLiterately, Pandoc)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((BlogLiterately -> Const (Maybe FilePath) BlogLiterately)
-> (BlogLiterately, Pandoc)
-> Const (Maybe FilePath) (BlogLiterately, Pandoc))
-> Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
-> Getting
(Maybe FilePath) (BlogLiterately, Pandoc) (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
Lens' BlogLiterately (Maybe FilePath)
style)
((BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> ((Maybe HsHighlight -> Identity (Maybe HsHighlight))
-> BlogLiterately -> Identity BlogLiterately)
-> (Maybe HsHighlight -> Identity (Maybe HsHighlight))
-> (BlogLiterately, Pandoc)
-> Identity (BlogLiterately, Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe HsHighlight -> Identity (Maybe HsHighlight))
-> BlogLiterately -> Identity BlogLiterately
Lens' BlogLiterately (Maybe HsHighlight)
hsHighlight) ((Maybe HsHighlight -> Identity (Maybe HsHighlight))
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> (Maybe HsHighlight -> Maybe HsHighlight)
-> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HsHighlight -> Maybe HsHighlight
forall a. a -> Maybe a
Just (HsHighlight -> Maybe HsHighlight)
-> (Maybe HsHighlight -> HsHighlight)
-> Maybe HsHighlight
-> Maybe HsHighlight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsHighlight
-> (HsHighlight -> HsHighlight) -> Maybe HsHighlight -> HsHighlight
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StylePrefs -> HsHighlight
HsColourInline StylePrefs
prefs)
((StylePrefs -> Identity StylePrefs)
-> HsHighlight -> Identity HsHighlight
Prism' HsHighlight StylePrefs
_HsColourInline ((StylePrefs -> Identity StylePrefs)
-> HsHighlight -> Identity HsHighlight)
-> StylePrefs -> HsHighlight -> HsHighlight
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StylePrefs
prefs)
citationsXF :: Transform
citationsXF :: Transform
citationsXF = (BlogLiterately -> Pandoc -> IO Pandoc)
-> (BlogLiterately -> Bool) -> Transform
ioTransform ((Pandoc -> IO Pandoc) -> BlogLiterately -> Pandoc -> IO Pandoc
forall a b. a -> b -> a
const Pandoc -> IO Pandoc
processCites') BlogLiterately -> Bool
citations'
profileXF :: Transform
profileXF :: Transform
profileXF = StateT (BlogLiterately, Pandoc) IO ()
-> (BlogLiterately -> Bool) -> Transform
Transform StateT (BlogLiterately, Pandoc) IO ()
doProfileXF (Bool -> BlogLiterately -> Bool
forall a b. a -> b -> a
const Bool
True)
where
doProfileXF :: StateT (BlogLiterately, Pandoc) IO ()
doProfileXF = do
BlogLiterately
bl <- Getting BlogLiterately (BlogLiterately, Pandoc) BlogLiterately
-> StateT (BlogLiterately, Pandoc) IO BlogLiterately
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting BlogLiterately (BlogLiterately, Pandoc) BlogLiterately
forall s t a b. Field1 s t a b => Lens s t a b
_1
BlogLiterately
bl' <- IO BlogLiterately
-> StateT (BlogLiterately, Pandoc) IO BlogLiterately
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BlogLiterately
-> StateT (BlogLiterately, Pandoc) IO BlogLiterately)
-> IO BlogLiterately
-> StateT (BlogLiterately, Pandoc) IO BlogLiterately
forall a b. (a -> b) -> a -> b
$ BlogLiterately -> IO BlogLiterately
loadProfile BlogLiterately
bl
(BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((BlogLiterately -> Identity BlogLiterately)
-> (BlogLiterately, Pandoc) -> Identity (BlogLiterately, Pandoc))
-> BlogLiterately -> StateT (BlogLiterately, Pandoc) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BlogLiterately
bl'
loadProfile :: BlogLiterately -> IO BlogLiterately
loadProfile :: BlogLiterately -> IO BlogLiterately
loadProfile bl :: BlogLiterately
bl =
case BlogLiterately
blBlogLiterately
-> Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
Lens' BlogLiterately (Maybe FilePath)
profile of
Nothing -> BlogLiterately -> IO BlogLiterately
forall (m :: * -> *) a. Monad m => a -> m a
return BlogLiterately
bl
Just profileName :: FilePath
profileName -> do
FilePath
appDir <- FilePath -> IO FilePath
getAppUserDataDirectory "BlogLiterately"
let profileCfg :: FilePath
profileCfg = FilePath
appDir FilePath -> FilePath -> FilePath
</> FilePath
profileName FilePath -> FilePath -> FilePath
<.> "cfg"
Bool
e <- FilePath -> IO Bool
doesFileExist FilePath
profileCfg
case Bool
e of
False -> do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
profileCfg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": file not found"
IO BlogLiterately
forall a. IO a
exitFailure
True -> do
(errs :: [ParseError]
errs, blProfile :: BlogLiterately
blProfile) <- FilePath -> ([ParseError], BlogLiterately)
readBLOptions (FilePath -> ([ParseError], BlogLiterately))
-> IO FilePath -> IO ([ParseError], BlogLiterately)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
profileCfg
(ParseError -> IO ()) -> [ParseError] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ParseError -> IO ()
forall a. Show a => a -> IO ()
print [ParseError]
errs
BlogLiterately -> IO BlogLiterately
forall (m :: * -> *) a. Monad m => a -> m a
return (BlogLiterately -> IO BlogLiterately)
-> BlogLiterately -> IO BlogLiterately
forall a b. (a -> b) -> a -> b
$ BlogLiterately -> BlogLiterately -> BlogLiterately
forall a. Monoid a => a -> a -> a
mappend BlogLiterately
blProfile BlogLiterately
bl
standardTransforms :: [Transform]
standardTransforms :: [Transform]
standardTransforms =
[
Transform
optionsXF
, Transform
profileXF
, Transform
passwordXF
, Transform
titleXF
, Transform
rawtexifyXF
, Transform
wptexifyXF
, Transform
ghciXF
, Transform
uploadImagesXF
, Transform
centerImagesXF
, Transform
specialLinksXF
, Transform
highlightOptsXF
, Transform
highlightXF
, Transform
citationsXF
]
xformDoc :: BlogLiterately -> [Transform] -> String -> IO (Either PandocError (BlogLiterately, String))
xformDoc :: BlogLiterately
-> [Transform]
-> FilePath
-> IO (Either PandocError (BlogLiterately, FilePath))
xformDoc bl :: BlogLiterately
bl xforms :: [Transform]
xforms s :: FilePath
s = do
Right tpl :: Template Text
tpl <- FilePath -> Text -> IO (Either FilePath (Template Text))
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate "" Text
blHtmlTemplate
PandocIO (BlogLiterately, FilePath)
-> IO (Either PandocError (BlogLiterately, FilePath))
forall a. PandocIO a -> IO (Either PandocError a)
runIO (PandocIO (BlogLiterately, FilePath)
-> IO (Either PandocError (BlogLiterately, FilePath)))
-> (FilePath -> PandocIO (BlogLiterately, FilePath))
-> FilePath
-> IO (Either PandocError (BlogLiterately, FilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
( FilePath -> FilePath
fixLineEndings
(FilePath -> FilePath)
-> (FilePath -> PandocIO (BlogLiterately, FilePath))
-> FilePath
-> PandocIO (BlogLiterately, FilePath)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FilePath -> Text
T.pack
(FilePath -> Text)
-> (Text -> PandocIO (BlogLiterately, FilePath))
-> FilePath
-> PandocIO (BlogLiterately, FilePath)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ReaderOptions -> Text -> PandocIO Pandoc
parseFile ReaderOptions
parseOpts
(Text -> PandocIO Pandoc)
-> (Pandoc -> PandocIO (BlogLiterately, FilePath))
-> Text
-> PandocIO (BlogLiterately, FilePath)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (IO (BlogLiterately, Pandoc) -> PandocIO (BlogLiterately, Pandoc)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (BlogLiterately, Pandoc) -> PandocIO (BlogLiterately, Pandoc))
-> (Pandoc -> IO (BlogLiterately, Pandoc))
-> Pandoc
-> PandocIO (BlogLiterately, Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transform]
-> BlogLiterately -> Pandoc -> IO (BlogLiterately, Pandoc)
runTransforms [Transform]
xforms BlogLiterately
bl)
(Pandoc -> PandocIO (BlogLiterately, Pandoc))
-> ((BlogLiterately, Pandoc)
-> PandocIO (BlogLiterately, FilePath))
-> Pandoc
-> PandocIO (BlogLiterately, FilePath)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(bl' :: BlogLiterately
bl', p :: Pandoc
p) -> (BlogLiterately
bl',) (Text -> (BlogLiterately, Text))
-> PandocIO Text -> PandocIO (BlogLiterately, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String (BlogLiterately -> Template Text -> WriterOptions
writeOpts BlogLiterately
bl' Template Text
tpl) Pandoc
p)
((BlogLiterately, Pandoc) -> PandocIO (BlogLiterately, Text))
-> ((BlogLiterately, Text) -> PandocIO (BlogLiterately, FilePath))
-> (BlogLiterately, Pandoc)
-> PandocIO (BlogLiterately, FilePath)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> PandocIO FilePath)
-> (BlogLiterately, Text) -> PandocIO (BlogLiterately, FilePath)
forall s t a b. Field2 s t a b => Lens s t a b
_2 (FilePath -> PandocIO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> PandocIO FilePath)
-> (Text -> FilePath) -> Text -> PandocIO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
)
(FilePath -> IO (Either PandocError (BlogLiterately, FilePath)))
-> FilePath -> IO (Either PandocError (BlogLiterately, FilePath))
forall a b. (a -> b) -> a -> b
$ FilePath
s
where
parseFile :: ReaderOptions -> Text -> PandocIO Pandoc
parseFile :: ReaderOptions -> Text -> PandocIO Pandoc
parseFile opts :: ReaderOptions
opts =
case BlogLiterately
blBlogLiterately
-> Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Maybe FilePath) BlogLiterately (Maybe FilePath)
Lens' BlogLiterately (Maybe FilePath)
format of
Just "rst" -> ReaderOptions -> Text -> PandocIO Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readRST ReaderOptions
opts
Just _ -> ReaderOptions -> Text -> PandocIO Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readMarkdown ReaderOptions
opts
Nothing ->
case FilePath -> FilePath
takeExtension (BlogLiterately -> FilePath
file' BlogLiterately
bl) of
".rst" -> ReaderOptions -> Text -> PandocIO Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readRST ReaderOptions
opts
".rest" -> ReaderOptions -> Text -> PandocIO Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readRST ReaderOptions
opts
".txt" -> ReaderOptions -> Text -> PandocIO Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readRST ReaderOptions
opts
_ -> ReaderOptions -> Text -> PandocIO Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readMarkdown ReaderOptions
opts
parseOpts :: ReaderOptions
parseOpts = ReaderOptions
forall a. Default a => a
def
{ readerExtensions :: Extensions
readerExtensions = Extensions
pandocExtensions Extensions -> (Extensions -> Extensions) -> Extensions
forall a b. a -> (a -> b) -> b
&
((Extensions -> Extensions)
-> (Extensions -> Extensions) -> Extensions -> Extensions)
-> (Extensions -> Extensions)
-> [Extensions -> Extensions]
-> Extensions
-> Extensions
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Extensions -> Extensions)
-> (Extensions -> Extensions) -> Extensions -> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Extensions -> Extensions
forall a. a -> a
id
[ Extension -> Extensions -> Extensions
enableExtension Extension
Ext_tex_math_single_backslash
, case BlogLiterately
blBlogLiterately
-> Getting (Maybe Bool) BlogLiterately (Maybe Bool) -> Maybe Bool
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Bool) BlogLiterately (Maybe Bool)
Lens' BlogLiterately (Maybe Bool)
litHaskell of
Just False -> Extensions -> Extensions
forall a. a -> a
id
_ -> Extension -> Extensions -> Extensions
enableExtension Extension
Ext_literate_haskell
]
}
writeOpts :: BlogLiterately -> Template Text -> WriterOptions
writeOpts bl :: BlogLiterately
bl tpl :: Template Text
tpl = WriterOptions
forall a. Default a => a
def
{ writerReferenceLinks :: Bool
writerReferenceLinks = Bool
True
, writerTableOfContents :: Bool
writerTableOfContents = BlogLiterately -> Bool
toc' BlogLiterately
bl
, writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod =
case BlogLiterately -> FilePath
math' BlogLiterately
bl of
"" -> HTMLMathMethod
PlainMath
opt :: FilePath
opt -> Text -> HTMLMathMethod
mathOption (FilePath -> Text
T.pack FilePath
opt)
, writerTemplate :: Maybe (Template Text)
writerTemplate = Template Text -> Maybe (Template Text)
forall a. a -> Maybe a
Just Template Text
tpl
}
mathOption :: Text -> HTMLMathMethod
mathOption opt :: Text
opt
| Text
opt Text -> Text -> Bool
`T.isPrefixOf` "mathml" = HTMLMathMethod
MathML
| Text
opt Text -> Text -> Bool
`T.isPrefixOf` "mimetex" =
Text -> HTMLMathMethod
WebTeX (Text -> Text -> Text
mathUrl "/cgi-bin/mimetex.cgi?" Text
opt)
| Text
opt Text -> Text -> Bool
`T.isPrefixOf` "webtex" = Text -> HTMLMathMethod
WebTeX (Text -> Text -> Text
mathUrl Text
webTeXURL Text
opt)
| Text
opt Text -> Text -> Bool
`T.isPrefixOf` "mathjax" = Text -> HTMLMathMethod
MathJax (Text -> Text -> Text
mathUrl Text
mathJaxURL Text
opt)
| Bool
otherwise = HTMLMathMethod
PlainMath
webTeXURL :: Text
webTeXURL = "http://chart.apis.google.com/chart?cht=tx&chl="
mathJaxURL :: Text
mathJaxURL = Text -> Text -> Text
T.append "http://cdn.mathjax.org/mathjax/latest/MathJax.js"
"?config=TeX-AMS-MML_HTMLorMML"
urlPart :: Text -> Text
urlPart :: Text -> Text
urlPart = Int -> Text -> Text
T.drop 1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='=')
mathUrl :: Text -> Text -> Text
mathUrl dflt :: Text
dflt opt :: Text
opt = case Text -> Text
urlPart Text
opt of "" -> Text
dflt; x :: Text
x -> Text
x
fixLineEndings :: String -> String
fixLineEndings :: FilePath -> FilePath
fixLineEndings [] = []
fixLineEndings ('\r':'\n':cs :: FilePath
cs) = '\n'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath -> FilePath
fixLineEndings FilePath
cs
fixLineEndings (c :: Char
c:cs :: FilePath
cs) = Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath -> FilePath
fixLineEndings FilePath
cs
blHtmlTemplate :: Text
blHtmlTemplate = [Text] -> Text
T.unlines
[ "$if(highlighting-css)$"
, " <style type=\"text/css\">"
, "$highlighting-css$"
, " </style>"
, "$endif$"
, "$for(css)$"
, " <link rel=\"stylesheet\" href=\"$css$\" $if(html5)$$else$type=\"text/css\" $endif$/>"
, "$endfor$"
, "$if(math)$"
, " $math$"
, "$endif$"
, "$if(toc)$"
, "<div id=\"$idprefix$TOC\">"
, "$toc$"
, "</div>"
, "$endif$"
, "$body$"
]