--------------------------------------------------------------------------------
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)]))

-- | Find symbol positions in the module.  Currently only searches in type
-- signatures.
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
    ]

--------------------------------------------------------------------------------
-- | Search for a needle in a haystack of lines. Only part the inside (startRow,
-- startCol), (endRow, endCol) is searched. The return value is the position of
-- the needle.
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