{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Sindre.Formatting( Format(..)
, FormatString
, textContents
, startBg
, parseFormatString
, unparseFormatString
)
where
import Sindre.Sindre hiding (string)
import Sindre.Runtime (Mold(..))
import Data.Attoparsec.Text
import Control.Applicative
import Control.Monad
import Data.Maybe
import qualified Data.Text as T
import Prelude hiding (takeWhile)
data Format = Fg String
| DefFg
| Bg String
| DefBg
| Text T.Text
deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Eq Format
Eq Format
-> (Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c< :: Format -> Format -> Bool
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
$cp1Ord :: Eq Format
Ord)
type FormatString = [Format]
instance Mold FormatString where
mold :: Value -> Maybe [Format]
mold Value
v = (String -> Maybe [Format])
-> ([Format] -> Maybe [Format])
-> Either String [Format]
-> Maybe [Format]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [Format] -> String -> Maybe [Format]
forall a b. a -> b -> a
const Maybe [Format]
forall a. Maybe a
Nothing) [Format] -> Maybe [Format]
forall a. a -> Maybe a
Just (Either String [Format] -> Maybe [Format])
-> (Text -> Either String [Format]) -> Text -> Maybe [Format]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String [Format]
parseFormatString (Text -> Maybe [Format]) -> Maybe Text -> Maybe [Format]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Maybe Text
forall a. Mold a => Value -> Maybe a
mold Value
v
unmold :: [Format] -> Value
unmold = Text -> Value
StringV (Text -> Value) -> ([Format] -> Text) -> [Format] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Format] -> Text
unparseFormatString
textContents :: FormatString -> T.Text
textContents :: [Format] -> Text
textContents = [Text] -> Text
T.concat ([Text] -> Text) -> ([Format] -> [Text]) -> [Format] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text) -> [Format] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Format -> Text
txt
where txt :: Format -> Text
txt (Text Text
s) = Text
s
txt Format
_ = Text
T.empty
startBg :: FormatString -> Maybe String
startBg :: [Format] -> Maybe String
startBg = Format -> Maybe String
getBg (Format -> Maybe String)
-> ([Format] -> Maybe Format) -> [Format] -> Maybe String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Format] -> Maybe Format
forall a. [a] -> Maybe a
listToMaybe ([Format] -> Maybe Format)
-> ([Format] -> [Format]) -> [Format] -> Maybe Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Bool) -> [Format] -> [Format]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Format -> Bool
ign
where ign :: Format -> Bool
ign (Text Text
_) = Bool
False
ign Format
DefBg = Bool
False
ign (Bg String
_) = Bool
False
ign Format
_ = Bool
True
getBg :: Format -> Maybe String
getBg (Bg String
bg) = String -> Maybe String
forall a. a -> Maybe a
Just String
bg
getBg Format
_ = Maybe String
forall a. Maybe a
Nothing
unparseFormatString :: FormatString -> T.Text
unparseFormatString :: [Format] -> Text
unparseFormatString = [Text] -> Text
T.concat ([Text] -> Text) -> ([Format] -> [Text]) -> [Format] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text) -> [Format] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Format -> Text
f
where f :: Format -> Text
f (Fg String
s) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"fg(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
f Format
DefFg = String -> Text
T.pack String
"fg()"
f (Bg String
s) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"bg(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
f Format
DefBg = String -> Text
T.pack String
"bg()"
f (Text Text
s) = Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"^") (String -> Text
T.pack String
"^^") Text
s
parseFormatString :: T.Text -> Either String FormatString
parseFormatString :: Text -> Either String [Format]
parseFormatString Text
s =
Result [Format] -> Either String [Format]
forall r. Result r -> Either String r
eitherResult (Result [Format] -> Either String [Format])
-> Result [Format] -> Either String [Format]
forall a b. (a -> b) -> a -> b
$ Parser [Format] -> Text -> Result [Format]
forall a. Parser a -> Text -> Result a
parse (Parser Text Format -> Parser [Format]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text Format
format Parser [Format] -> Parser Text () -> Parser [Format]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
s Result [Format] -> Text -> Result [Format]
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` Text
T.empty
format :: Parser Format
format :: Parser Text Format
format = Char -> Parser Char
char Char
'^' Parser Char -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Format
command Parser Text Format -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Format
text
text :: Parser Format
text :: Parser Text Format
text = Text -> Format
Text (Text -> Format) -> Parser Text Text -> Parser Text Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'^')
command :: Parser Format
command :: Parser Text Format
command = Text -> Format
Text (Text -> Format) -> Parser Text Text -> Parser Text Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Text Text
string (String -> Text
T.pack String
"^")
Parser Text Format -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
string (String -> Text
T.pack String
"fg(")
Parser Text Text -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Format
Fg (String -> Format) -> (Text -> String) -> Text -> Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack (Text -> Format) -> Parser Text Text -> Parser Text Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
')') Parser Text Format -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Format -> Parser Text Format
forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
DefFg)
Parser Text Format -> Parser Text Text -> Parser Text Format
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string (String -> Text
T.pack String
")")
Parser Text Format -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
string (String -> Text
T.pack String
"bg(")
Parser Text Text -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Format
Bg (String -> Format) -> (Text -> String) -> Text -> Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> String
T.unpack (Text -> Format) -> Parser Text Text -> Parser Text Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
')') Parser Text Format -> Parser Text Format -> Parser Text Format
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Format -> Parser Text Format
forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
DefBg)
Parser Text Format -> Parser Text Text -> Parser Text Format
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
string (String -> Text
T.pack String
")")