module Language.Haskell.Stylish.Step.UnicodeSyntax
( step
) where
import Data.List (isPrefixOf,
sort)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (maybeToList)
import GHC.Hs.Binds
import GHC.Hs.Extension (GhcPs)
import GHC.Hs.Types
import Language.Haskell.Stylish.Block
import Language.Haskell.Stylish.Editor
import Language.Haskell.Stylish.Module
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Step.LanguagePragmas (addLanguagePragma)
import Language.Haskell.Stylish.Util
unicodeReplacements :: Map String String
unicodeReplacements :: Map String String
unicodeReplacements = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (String
"::", String
"∷")
, (String
"=>", String
"⇒")
, (String
"->", String
"→")
, (String
"<-", String
"←")
, (String
"forall", String
"∀")
, (String
"-<", String
"↢")
, (String
">-", String
"↣")
]
replaceAll :: [(Int, [(Int, String)])] -> [Change String]
replaceAll :: [(Int, [(Int, String)])] -> [Change String]
replaceAll = ((Int, [(Int, String)]) -> Change String)
-> [(Int, [(Int, String)])] -> [Change String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [(Int, String)]) -> Change String
changeLine'
where
changeLine' :: (Int, [(Int, String)]) -> Change String
changeLine' (Int
r, [(Int, String)]
ns) = Int -> (String -> [String]) -> Change String
forall a. Int -> (a -> [a]) -> Change a
changeLine Int
r ((String -> [String]) -> Change String)
-> (String -> [String]) -> Change String
forall a b. (a -> b) -> a -> b
$ \String
str -> String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
[Change Char] -> String -> String
forall a. [Change a] -> [a] -> [a]
applyChanges
[ Block Char -> (String -> String) -> Change Char
forall a. Block a -> ([a] -> [a]) -> Change a
change (Int -> Int -> Block Char
forall a. Int -> Int -> Block a
Block Int
c Int
ec) (String -> String -> String
forall a b. a -> b -> a
const String
repl)
| (Int
c, String
needle) <- [(Int, String)] -> [(Int, String)]
forall a. Ord a => [a] -> [a]
sort [(Int, String)]
ns
, let ec :: Int
ec = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
needle Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
, String
repl <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
needle Map String String
unicodeReplacements
] String
str
groupPerLine :: [((Int, Int), a)] -> [(Int, [(Int, a)])]
groupPerLine :: [((Int, Int), a)] -> [(Int, [(Int, a)])]
groupPerLine = Map Int [(Int, a)] -> [(Int, [(Int, a)])]
forall k a. Map k a -> [(k, a)]
M.toList (Map Int [(Int, a)] -> [(Int, [(Int, a)])])
-> ([((Int, Int), a)] -> Map Int [(Int, a)])
-> [((Int, Int), a)]
-> [(Int, [(Int, a)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, a)] -> [(Int, a)] -> [(Int, a)])
-> [(Int, [(Int, a)])] -> Map Int [(Int, a)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [(Int, a)])] -> Map Int [(Int, a)])
-> ([((Int, Int), a)] -> [(Int, [(Int, a)])])
-> [((Int, Int), a)]
-> Map Int [(Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((Int, Int), a) -> (Int, [(Int, a)]))
-> [((Int, Int), a)] -> [(Int, [(Int, a)])]
forall a b. (a -> b) -> [a] -> [b]
map (\((Int
r, Int
c), a
x) -> (Int
r, [(Int
c, a
x)]))
findSymbol :: Module -> Lines -> String -> [((Int, Int), String)]
findSymbol :: Module -> [String] -> String -> [((Int, Int), String)]
findSymbol Module
module' [String]
ls String
sym =
[ ((Int, Int)
pos, String
sym)
| TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
funLoc LHsSigWcType GhcPs
typeLoc <- [LHsDecl GhcPs] -> [Sig GhcPs]
forall a b. (Data a, Data b) => a -> [b]
everything (Decls -> [LHsDecl GhcPs]
rawModuleDecls (Decls -> [LHsDecl GhcPs]) -> Decls -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ Module -> Decls
moduleDecls Module
module') :: [Sig GhcPs]
, ((Int, Int)
funStart, (Int, Int)
_) <- [Located RdrName] -> [((Int, Int), (Int, Int))]
forall pass. [Located pass] -> [((Int, Int), (Int, Int))]
infoPoints [Located (IdP GhcPs)]
[Located RdrName]
funLoc
, ((Int, Int)
_, (Int, Int)
typeEnd) <- [Located (HsType GhcPs)] -> [((Int, Int), (Int, Int))]
forall pass. [Located pass] -> [((Int, Int), (Int, Int))]
infoPoints [LHsSigWcType GhcPs -> Located (HsType GhcPs)
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType GhcPs
typeLoc]
, (Int, Int)
pos <- Maybe (Int, Int) -> [(Int, Int)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Int, Int) -> [(Int, Int)])
-> Maybe (Int, Int) -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> (Int, Int) -> String -> [String] -> Maybe (Int, Int)
between (Int, Int)
funStart (Int, Int)
typeEnd String
sym [String]
ls
]
between :: (Int, Int) -> (Int, Int) -> String -> Lines -> Maybe (Int, Int)
between :: (Int, Int) -> (Int, Int) -> String -> [String] -> Maybe (Int, Int)
between (Int
startRow, Int
startCol) (Int
endRow, Int
endCol) String
needle =
(Int, Int) -> [String] -> Maybe (Int, Int)
forall a b. (Num a, Num b) => (a, b) -> [String] -> Maybe (a, b)
search (Int
startRow, Int
startCol) ([String] -> Maybe (Int, Int))
-> ([String] -> [String]) -> [String] -> Maybe (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String -> String) -> [String] -> [String]
forall a. (a -> a) -> [a] -> [a]
withLast (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
endCol) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String -> String) -> [String] -> [String]
forall a. (a -> a) -> [a] -> [a]
withHead (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int -> String -> String) -> Int -> String -> String
forall a b. (a -> b) -> a -> b
$ Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Int
endRow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startRow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
startRow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
search :: (a, b) -> [String] -> Maybe (a, b)
search (a, b)
_ [] = Maybe (a, b)
forall a. Maybe a
Nothing
search (a
r, b
_) ([] : [String]
xs) = (a, b) -> [String] -> Maybe (a, b)
search (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
1) [String]
xs
search (a
r, b
c) (String
x : [String]
xs)
| String
needle String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
r, b
c)
| Bool
otherwise = (a, b) -> [String] -> Maybe (a, b)
search (a
r, b
c b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) (String -> String
forall a. [a] -> [a]
tail String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
step :: Bool -> String -> Step
step :: Bool -> String -> Step
step = (String -> ([String] -> Module -> [String]) -> Step
makeStep String
"UnicodeSyntax" (([String] -> Module -> [String]) -> Step)
-> (String -> [String] -> Module -> [String]) -> String -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((String -> [String] -> Module -> [String]) -> String -> Step)
-> (Bool -> String -> [String] -> Module -> [String])
-> Bool
-> String
-> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> [String] -> Module -> [String]
step'
step' :: Bool -> String -> Lines -> Module -> Lines
step' :: Bool -> String -> [String] -> Module -> [String]
step' Bool
alp String
lg [String]
ls Module
module' = [Change String] -> [String] -> [String]
forall a. [Change a] -> [a] -> [a]
applyChanges [Change String]
changes [String]
ls
where
changes :: [Change String]
changes = (if Bool
alp then String -> String -> Module -> [Change String]
addLanguagePragma String
lg String
"UnicodeSyntax" Module
module' else []) [Change String] -> [Change String] -> [Change String]
forall a. [a] -> [a] -> [a]
++
[(Int, [(Int, String)])] -> [Change String]
replaceAll [(Int, [(Int, String)])]
perLine
toReplace :: [String]
toReplace = [ String
"::", String
"=>", String
"->" ]
perLine :: [(Int, [(Int, String)])]
perLine = [(Int, [(Int, String)])] -> [(Int, [(Int, String)])]
forall a. Ord a => [a] -> [a]
sort ([(Int, [(Int, String)])] -> [(Int, [(Int, String)])])
-> [(Int, [(Int, String)])] -> [(Int, [(Int, String)])]
forall a b. (a -> b) -> a -> b
$ [((Int, Int), String)] -> [(Int, [(Int, String)])]
forall a. [((Int, Int), a)] -> [(Int, [(Int, a)])]
groupPerLine ([((Int, Int), String)] -> [(Int, [(Int, String)])])
-> [((Int, Int), String)] -> [(Int, [(Int, String)])]
forall a b. (a -> b) -> a -> b
$ (String -> [((Int, Int), String)])
-> [String] -> [((Int, Int), String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Module -> [String] -> String -> [((Int, Int), String)]
findSymbol Module
module' [String]
ls) [String]
toReplace