{-# LANGUAGE OverloadedStrings #-}
module Text.Gemini
(
GemDocument
, GemItem (..)
, decode
, decodeLine
, encode
, encodeItem
) where
import Data.Text (Text)
import qualified Data.Text as T
import Data.Maybe (maybeToList)
import Data.Char (isSpace)
import Data.List (foldl')
import Data.Bool (bool)
type GemDocument = [GemItem]
data GemItem = GemText !Text
| GemLink !Text !(Maybe Text)
| GemHeading !Int !Text
| GemList ![Text]
| GemQuote !Text
| GemPre ![Text] !(Maybe Text)
deriving (Int -> GemItem -> ShowS
GemDocument -> ShowS
GemItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: GemDocument -> ShowS
$cshowList :: GemDocument -> ShowS
show :: GemItem -> String
$cshow :: GemItem -> String
showsPrec :: Int -> GemItem -> ShowS
$cshowsPrec :: Int -> GemItem -> ShowS
Show, GemItem -> GemItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GemItem -> GemItem -> Bool
$c/= :: GemItem -> GemItem -> Bool
== :: GemItem -> GemItem -> Bool
$c== :: GemItem -> GemItem -> Bool
Eq)
decode :: Text -> GemDocument
decode :: Text -> GemDocument
decode = GemDocument -> [Text] -> GemDocument
parse [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
where
parse :: GemDocument -> [Text] -> GemDocument
parse :: GemDocument -> [Text] -> GemDocument
parse GemDocument
doc (Text
l:[Text]
ls)
| Text
l Text -> Text -> Bool
`hasValueOf` Text
"* " = GemDocument -> [Text] -> [Text] -> GemDocument
parseList GemDocument
doc [Int -> Text -> Text
value Int
1 Text
l] [Text]
ls
| Text
"```" Text -> Text -> Bool
`T.isPrefixOf` Text
l = GemDocument -> [Text] -> Maybe Text -> [Text] -> GemDocument
parsePre GemDocument
doc [] (Text -> Maybe Text
optional forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
value Int
3 Text
l) [Text]
ls
| Bool
otherwise = GemDocument -> [Text] -> GemDocument
parse (GemDocument
doc forall a. Semigroup a => a -> a -> a
<> [Text -> GemItem
decodeLine Text
l]) [Text]
ls
parse GemDocument
doc [] = GemDocument
doc
parseList :: GemDocument -> [Text] -> [Text] -> GemDocument
parseList :: GemDocument -> [Text] -> [Text] -> GemDocument
parseList GemDocument
doc [Text]
glist (Text
l:[Text]
ls)
| Text
l Text -> Text -> Bool
`hasValueOf` Text
"* " = GemDocument -> [Text] -> [Text] -> GemDocument
parseList GemDocument
doc ([Text]
glist forall a. Semigroup a => a -> a -> a
<> [Int -> Text -> Text
value Int
1 Text
l]) [Text]
ls
| Bool
otherwise = GemDocument -> [Text] -> GemDocument
parse (GemDocument
doc forall a. Semigroup a => a -> a -> a
<> [[Text] -> GemItem
GemList [Text]
glist]) (Text
lforall a. a -> [a] -> [a]
:[Text]
ls)
parseList GemDocument
doc [Text]
glist [] = GemDocument
doc forall a. Semigroup a => a -> a -> a
<> [[Text] -> GemItem
GemList [Text]
glist]
parsePre :: GemDocument -> [Text] -> Maybe Text -> [Text] -> GemDocument
parsePre :: GemDocument -> [Text] -> Maybe Text -> [Text] -> GemDocument
parsePre GemDocument
doc [Text]
glines Maybe Text
alt (Text
l:[Text]
ls)
| Text
"```" Text -> Text -> Bool
`T.isPrefixOf` Text
l = GemDocument -> [Text] -> GemDocument
parse (GemDocument
doc forall a. Semigroup a => a -> a -> a
<> [[Text] -> Maybe Text -> GemItem
GemPre [Text]
glines Maybe Text
alt]) [Text]
ls
| Bool
otherwise = GemDocument -> [Text] -> Maybe Text -> [Text] -> GemDocument
parsePre GemDocument
doc ([Text]
glines forall a. Semigroup a => a -> a -> a
<> [Text
l]) Maybe Text
alt [Text]
ls
parsePre GemDocument
doc [Text]
glines Maybe Text
alt [] = GemDocument
doc forall a. Semigroup a => a -> a -> a
<> [[Text] -> Maybe Text -> GemItem
GemPre [Text]
glines Maybe Text
alt]
decodeLine :: Text -> GemItem
decodeLine :: Text -> GemItem
decodeLine Text
line
| Text
line Text -> Text -> Bool
`hasValueOf` Text
"=>" = let (Text
link, Text
desc) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
value Int
2 Text
line
in Text -> Maybe Text -> GemItem
GemLink Text
link forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
optional forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
desc
| Text
line Text -> Text -> Bool
`hasValueOf` Text
"#" = Text -> GemItem
parseHeading Text
line
| Text
line Text -> Text -> Bool
`hasValueOf` Text
"* " = [Text] -> GemItem
GemList [Int -> Text -> Text
value Int
1 Text
line]
| Text
line Text -> Text -> Bool
`hasValueOf` Text
">" = Text -> GemItem
GemQuote forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
value Int
1 Text
line
| Bool
otherwise = Text -> GemItem
GemText forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd Text
line
where
parseHeading :: Text -> GemItem
parseHeading :: Text -> GemItem
parseHeading Text
l
| Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
text = Text -> GemItem
GemText forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
l
| Bool
otherwise = Int -> Text -> GemItem
GemHeading (forall a. Ord a => a -> a -> a
min (Text -> Int
T.length Text
pre) Int
3) forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
text
where (Text
pre, Text
text) = (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
==Char
'#') Text
l
encode :: GemDocument -> Text
encode :: GemDocument -> Text
encode = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[Text]
acc GemItem
x -> [Text]
acc forall a. Semigroup a => a -> a -> a
<> [GemItem -> Text
encodeItem GemItem
x]) []
encodeItem :: GemItem -> Text
encodeItem :: GemItem -> Text
encodeItem (GemText Text
line) = Text -> Text
escapePrefixes Text
line
encodeItem (GemLink Text
link Maybe Text
desc) = [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ [Text
"=>", Text
link] forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> [a]
maybeToList Maybe Text
desc
encodeItem (GemHeading Int
level Text
text) = [Text] -> Text
T.unwords [Int -> Text -> Text
T.replicate (forall a. Ord a => a -> a -> a
min Int
level Int
3) Text
"#", Text
text]
encodeItem (GemList [Text]
list) = Text -> Text
T.stripEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
T.append Text
"* ") [Text]
list
encodeItem (GemQuote Text
text) = [Text] -> Text
T.unwords [Text
">", Text
text]
encodeItem (GemPre [Text]
text Maybe Text
alt) = Text -> Text
T.stripEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ [[Text] -> Text
T.concat ([Text
"```"] forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> [a]
maybeToList Maybe Text
alt)] forall a. Semigroup a => a -> a -> a
<> [Text]
text forall a. Semigroup a => a -> a -> a
<> [Text
"```"]
escapePrefixes :: Text -> Text
escapePrefixes :: Text -> Text
escapePrefixes Text
line = forall a. a -> a -> Bool -> a
bool Text
line (Char -> Text -> Text
T.cons Char
' ' Text
line) Bool
escape
where escape :: Bool
escape = Text
"```" Text -> Text -> Bool
`T.isPrefixOf` Text
line Bool -> Bool -> Bool
||
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
hasValueOf Text
line) [Text
"=>", Text
"* ", Text
">"] Bool -> Bool -> Bool
||
(Text
line Text -> Text -> Bool
`hasValueOf` Text
"#" Bool -> Bool -> Bool
&& let (Text
_, Text
text) = (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
==Char
'#') Text
line
in Bool -> Bool
not (Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
text))
hasValueOf :: Text -> Text -> Bool
hasValueOf :: Text -> Text -> Bool
hasValueOf Text
line Text
prefix = Text
prefix Text -> Text -> Bool
`T.isPrefixOf` Text
line Bool -> Bool -> Bool
&&
Bool -> Bool
not (Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
value (Text -> Int
T.length Text
prefix) Text
line)
value :: Int -> Text -> Text
value :: Int -> Text -> Text
value Int
prefix = Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
prefix
optional :: Text -> Maybe Text
optional :: Text -> Maybe Text
optional Text
text = if Text -> Bool
T.null Text
text then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
text