{-# LANGUAGE TupleSections #-}
module Nixfmt.Util
( manyP
, someP
, manyText
, someText
, commonPrefix
, commonIndentation
, dropCommonIndentation
, identChar
, isSpaces
, pathChar
, replaceMultiple
, schemeChar
, uriChar
) where
import Control.Applicative ((<|>))
import Data.Char (isAlpha, isDigit, isSpace)
import Data.Foldable (asum)
import Data.List (unfoldr)
import Data.Maybe (fromMaybe)
import Data.Text as Text
(Text, all, commonPrefixes, concat, empty, null, splitAt, stripEnd, stripPrefix, takeWhile)
import Text.Megaparsec
(ParsecT, Stream, Token, Tokens, many, some, takeWhile1P, takeWhileP)
charClass :: [Char] -> Char -> Bool
charClass :: [Char] -> Char -> Bool
charClass [Char]
s Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char]
s
identChar :: Char -> Bool
identChar :: Char -> Bool
identChar = [Char] -> Char -> Bool
charClass [Char]
"_'-"
pathChar :: Char -> Bool
pathChar :: Char -> Bool
pathChar = [Char] -> Char -> Bool
charClass [Char]
"._-+~"
schemeChar :: Char -> Bool
schemeChar :: Char -> Bool
schemeChar = [Char] -> Char -> Bool
charClass [Char]
"-.+"
uriChar :: Char -> Bool
uriChar :: Char -> Bool
uriChar = [Char] -> Char -> Bool
charClass [Char]
"~!@$%&*-=_+:',./?"
someP :: (Stream s, Ord e) => (Token s -> Bool) -> ParsecT e s m (Tokens s)
someP :: (Token s -> Bool) -> ParsecT e s m (Tokens s)
someP = Maybe [Char] -> (Token s -> Bool) -> ParsecT e s m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing
manyP :: (Stream s, Ord e) => (Token s -> Bool) -> ParsecT e s m (Tokens s)
manyP :: (Token s -> Bool) -> ParsecT e s m (Tokens s)
manyP = Maybe [Char] -> (Token s -> Bool) -> ParsecT e s m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing
someText :: (Stream s, Ord e) => ParsecT e s m Text -> ParsecT e s m Text
someText :: ParsecT e s m Text -> ParsecT e s m Text
someText ParsecT e s m Text
p = [Text] -> Text
Text.concat ([Text] -> Text) -> ParsecT e s m [Text] -> ParsecT e s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e s m Text -> ParsecT e s m [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT e s m Text
p
manyText :: (Stream s, Ord e) => ParsecT e s m Text -> ParsecT e s m Text
manyText :: ParsecT e s m Text -> ParsecT e s m Text
manyText ParsecT e s m Text
p = [Text] -> Text
Text.concat ([Text] -> Text) -> ParsecT e s m [Text] -> ParsecT e s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT e s m Text -> ParsecT e s m [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT e s m Text
p
commonPrefix :: Text -> Text -> Text
commonPrefix :: Text -> Text -> Text
commonPrefix Text
a Text
b =
case Text -> Text -> Maybe (Text, Text, Text)
commonPrefixes Text
a Text
b of
Maybe (Text, Text, Text)
Nothing -> Text
empty
Just (Text
prefix, Text
_, Text
_) -> Text
prefix
commonIndentation :: [Text] -> Maybe Text
commonIndentation :: [Text] -> Maybe Text
commonIndentation [] = Maybe Text
forall a. Maybe a
Nothing
commonIndentation [Text
x] = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Text.takeWhile Char -> Bool
isSpace Text
x
commonIndentation (Text
x:Text
y:[Text]
xs) = [Text] -> Maybe Text
commonIndentation (Text -> Text -> Text
commonPrefix Text
x Text
y Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)
dropCommonIndentation :: [Text] -> [Text]
dropCommonIndentation :: [Text] -> [Text]
dropCommonIndentation [Text]
unstrippedLines =
let strippedLines :: [Text]
strippedLines = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
stripEnd [Text]
unstrippedLines
in case [Text] -> Maybe Text
commonIndentation ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
empty) [Text]
strippedLines) of
Maybe Text
Nothing -> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a b. a -> b -> a
const Text
empty) [Text]
strippedLines
Just Text
indentation -> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
empty (Maybe Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text
stripPrefix Text
indentation) [Text]
strippedLines
isSpaces :: Text -> Bool
isSpaces :: Text -> Bool
isSpaces = (Char -> Bool) -> Text -> Bool
Text.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ')
replaceMultiple :: [(Text, Text)] -> Text -> Text
replaceMultiple :: [(Text, Text)] -> Text -> Text
replaceMultiple [(Text, Text)]
replacements = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Text, Text)) -> Text -> [Text]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Text -> Maybe (Text, Text)
replaceAny
where
replaceAny :: Text -> Maybe (Text, Text)
replaceAny :: Text -> Maybe (Text, Text)
replaceAny Text
t
| Text -> Bool
Text.null Text
t = Maybe (Text, Text)
forall a. Maybe a
Nothing
| Bool
otherwise = [Maybe (Text, Text)] -> Maybe (Text, Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (((Text, Text) -> Maybe (Text, Text))
-> [(Text, Text)] -> [Maybe (Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> (Text, Text) -> Maybe (Text, Text)
replaceStart Text
t) [(Text, Text)]
replacements)
Maybe (Text, Text) -> Maybe (Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Int -> Text -> (Text, Text)
Text.splitAt Int
1 Text
t)
replaceStart :: Text -> (Text, Text) -> Maybe (Text, Text)
replaceStart :: Text -> (Text, Text) -> Maybe (Text, Text)
replaceStart Text
t (Text
pat, Text
rep) = (Text
rep,) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
Text.stripPrefix Text
pat Text
t