{-# LANGUAGE OverloadedStrings #-}

module Web.Hablog.Utils where

import Control.Arrow ((&&&))
import qualified Data.Text.Lazy as T
import qualified Data.Map as M
import qualified Text.Markdown as MD
import qualified Text.Blaze.Html5 as H

hd :: [a] -> Maybe a
hd :: [a] -> Maybe a
hd [] = Maybe a
forall a. Maybe a
Nothing
hd (x :: a
x:_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

at :: [a] -> Int -> Maybe a
at :: [a] -> Int -> Maybe a
at [] _ = Maybe a
forall a. Maybe a
Nothing
at (x :: a
x:xs :: [a]
xs) n :: Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = [a]
xs [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
`at` (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  | Bool
otherwise = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
`at` (-Int
n)

headerBreaker :: T.Text
headerBreaker :: Text
headerBreaker = "---"

takeJust :: [Maybe a] -> Maybe a
takeJust :: [Maybe a] -> Maybe a
takeJust [] = Maybe a
forall a. Maybe a
Nothing
takeJust (Just x :: a
x:_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
takeJust (Nothing:xs :: [Maybe a]
xs) = [Maybe a] -> Maybe a
forall a. [Maybe a] -> Maybe a
takeJust [Maybe a]
xs

convert :: Char -> [String] -> String
convert :: Char -> [String] -> String
convert c :: Char
c str :: [String]
str = (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
c]) ([String] -> [String]
forall a. [a] -> [a]
init [String]
str) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
last [String]
str

splitBy :: Char -> String -> [String]
splitBy :: Char -> String -> [String]
splitBy c :: Char
c txt :: String
txt = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
go [] String
txt
  where go :: String -> String -> [String]
go xs :: String
xs [] = [String
xs]
        go xs :: String
xs (y :: Char
y:ys :: String
ys)
          | Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c    = String
xs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> String -> [String]
go [] String
ys
          | Bool
otherwise = String -> String -> [String]
go (Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) String
ys

removeWhitespaces :: String -> String
removeWhitespaces :: String -> String
removeWhitespaces = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

infixl 0 |>
(|>) :: a -> (a -> b) -> b
x :: a
x |> :: a -> (a -> b) -> b
|> f :: a -> b
f = a -> b
f a
x

partition :: Char -> T.Text -> (T.Text, T.Text)
partition :: Char -> Text -> (Text, Text)
partition c :: Char
c = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
c) (Text -> Text) -> (Text -> Text) -> Text -> (Text, Text)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ([Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (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
==Char
c) (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
/=Char
c))


getHeader :: T.Text -> M.Map T.Text T.Text
getHeader :: Text -> Map Text Text
getHeader = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> (Text -> [(Text, Text)]) -> Text -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=)"" (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd) ([(Text, Text)] -> [(Text, Text)])
-> (Text -> [(Text, Text)]) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Text -> (Text, Text)
partition ':') ([Text] -> [(Text, Text)])
-> (Text -> [Text]) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isPrefixOf Text
headerBreaker) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

getContent :: T.Text -> T.Text
getContent :: Text -> Text
getContent = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
T.isPrefixOf Text
headerBreaker) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isPrefixOf Text
headerBreaker) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

createBody :: T.Text -> H.Html
createBody :: Text -> Html
createBody = MarkdownSettings -> Text -> Html
MD.markdown MarkdownSettings
forall a. Default a => a
MD.def