diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index 717ea6b..74c5163 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -16,6 +16,7 @@ import Language.Haskell.GhcMod.Doc (showPage, showOneLine, styleUnqualified) import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Gap import Language.Haskell.GhcMod.Monad +import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Types import Name (getOccString) import Outputable (ppr, Outputable) diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs new file mode 100644 index 0000000..339be0f --- /dev/null +++ b/Language/Haskell/GhcMod/Convert.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Language.Haskell.GhcMod.Convert where + +import Language.Haskell.GhcMod.Monad +import Language.Haskell.GhcMod.Types + +import Control.Applicative ((<$>)) + +type Builder = String -> String + +-- | +-- +-- >>> replace '"' "\\\"" "foo\"bar" "" +-- "foo\\\"bar" +replace :: Char -> String -> String -> Builder +replace _ _ [] = id +replace c cs (x:xs) + | x == c = (cs ++) . replace c cs xs + | otherwise = (x :) . replace c cs xs + +inter :: Char -> [Builder] -> Builder +inter _ [] = id +inter c bs = foldr1 (\x y -> x . (c:) . y) bs + +convert' :: ToString a => a -> GhcMod String +convert' x = flip convert x <$> options + +convert :: ToString a => Options -> a -> String +convert opt@Options { outputStyle = LispStyle } x = toLisp opt x "\n" +convert opt@Options { outputStyle = PlainStyle } x + | str == "\n" = "" + | otherwise = str + where + str = toPlain opt x "\n" + +class ToString a where + toLisp :: Options -> a -> Builder + toPlain :: Options -> a -> Builder + +lineSep :: Options -> String +lineSep opt = lsep + where + LineSeparator lsep = lineSeparator opt + +-- | +-- +-- >>> toLisp defaultOptions "fo\"o" "" +-- "\"fo\\\"o\"" +-- >>> toPlain defaultOptions "foo" "" +-- "foo" +instance ToString String where + toLisp opt = quote opt + toPlain opt = replace '\n' (lineSep opt) + +-- | +-- +-- >>> toLisp defaultOptions ["foo", "bar", "ba\"z"] "" +-- "(\"foo\" \"bar\" \"ba\\\"z\")" +-- >>> toPlain defaultOptions ["foo", "bar", "baz"] "" +-- "foo\nbar\nbaz" +instance ToString [String] where + toLisp opt = toSexp1 opt + toPlain opt = inter '\n' . map (toPlain opt) + +-- | +-- +-- >>> let inp = [((1,2,3,4),"foo"),((5,6,7,8),"bar")] :: [((Int,Int,Int,Int),String)] +-- >>> toLisp defaultOptions inp "" +-- "((1 2 3 4 \"foo\") (5 6 7 8 \"bar\"))" +-- >>> toPlain defaultOptions inp "" +-- "1 2 3 4 \"foo\"\n5 6 7 8 \"bar\"" +instance ToString [((Int,Int,Int,Int),String)] where + toLisp opt = toSexp2 . map toS + where + toS x = ('(' :) . tupToString opt x . (')' :) + toPlain opt = inter '\n' . map (tupToString opt) + +toSexp1 :: Options -> [String] -> Builder +toSexp1 opt ss = ('(' :) . inter ' ' (map (quote opt) ss) . (')' :) + +toSexp2 :: [Builder] -> Builder +toSexp2 ss = ('(' :) . (inter ' ' ss) . (')' :) + +tupToString :: Options -> ((Int,Int,Int,Int),String) -> Builder +tupToString opt ((a,b,c,d),s) = (show a ++) . (' ' :) + . (show b ++) . (' ' :) + . (show c ++) . (' ' :) + . (show d ++) . (' ' :) + . quote opt s -- fixme: quote is not necessary + +quote :: Options -> String -> Builder +quote opt str = ("\"" ++) . (quote' str ++) . ("\"" ++) + where + lsep = lineSep opt + quote' [] = [] + quote' (x:xs) + | x == '\n' = lsep ++ quote' xs + | x == '\\' = "\\\\" ++ quote' xs + | x == '"' = "\\\"" ++ quote' xs + | otherwise = x : quote' xs + +---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index cfa0a35..8de00dc 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -7,6 +7,7 @@ import Data.List (intercalate) import Data.Maybe (fromMaybe, isJust, fromJust) import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.GHCApi +import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Types ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index 63e5d77..f5ee9ba 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -9,6 +9,7 @@ import GHC (Ghc) import qualified GHC as G import Language.Haskell.GhcMod.Browse (browseAll) import Language.Haskell.GhcMod.GHCApi +import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Types #ifndef MIN_VERSION_containers diff --git a/Language/Haskell/GhcMod/Flag.hs b/Language/Haskell/GhcMod/Flag.hs index cfd4e8a..ff00fde 100644 --- a/Language/Haskell/GhcMod/Flag.hs +++ b/Language/Haskell/GhcMod/Flag.hs @@ -1,6 +1,7 @@ module Language.Haskell.GhcMod.Flag where import qualified Language.Haskell.GhcMod.Gap as Gap +import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Types -- | Listing GHC flags. (e.g -fno-warn-orphans) diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 25dc417..0159fa5 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/Language/Haskell/GhcMod/Info.hs @@ -25,6 +25,7 @@ import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Gap (HasType(..), setDeferTypeErrors) import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types +import Language.Haskell.GhcMod.Convert import Outputable (PprStyle) import TcHsSyn (hsPatType) diff --git a/Language/Haskell/GhcMod/Lang.hs b/Language/Haskell/GhcMod/Lang.hs index 858d1b2..1ddc59a 100644 --- a/Language/Haskell/GhcMod/Lang.hs +++ b/Language/Haskell/GhcMod/Lang.hs @@ -2,6 +2,7 @@ module Language.Haskell.GhcMod.Lang where import DynFlags (supportedLanguagesAndExtensions) import Language.Haskell.GhcMod.Types +import Language.Haskell.GhcMod.Convert -- | Listing language extensions. diff --git a/Language/Haskell/GhcMod/Lint.hs b/Language/Haskell/GhcMod/Lint.hs index 49a54f4..23515be 100644 --- a/Language/Haskell/GhcMod/Lint.hs +++ b/Language/Haskell/GhcMod/Lint.hs @@ -3,6 +3,7 @@ module Language.Haskell.GhcMod.Lint where import Control.Applicative ((<$>)) import Control.Exception (handle, SomeException(..)) import Language.Haskell.GhcMod.Logger (checkErrorPrefix) +import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Types import Language.Haskell.HLint (hlint) diff --git a/Language/Haskell/GhcMod/List.hs b/Language/Haskell/GhcMod/List.hs index e7565e9..5fcf32a 100644 --- a/Language/Haskell/GhcMod/List.hs +++ b/Language/Haskell/GhcMod/List.hs @@ -5,6 +5,7 @@ import Control.Exception (SomeException(..)) import Data.List (nub, sort) import qualified GHC as G import Language.Haskell.GhcMod.Monad +import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Types import Packages (pkgIdMap, exposedModules, sourcePackageId, display) import UniqFM (eltsUFM) diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index 5654cf1..9039382 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -19,7 +19,8 @@ import HscTypes (SourceError, srcErrorMessages) import Language.Haskell.GhcMod.Doc (showPage, getStyle) import Language.Haskell.GhcMod.GHCApi (withDynFlags, withCmdFlags) import qualified Language.Haskell.GhcMod.Gap as Gap -import Language.Haskell.GhcMod.Types (Options(..), convert) +import Language.Haskell.GhcMod.Convert (convert) +import Language.Haskell.GhcMod.Types (Options(..)) import Outputable (PprStyle, SDoc) import System.FilePath (normalise) diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 59f7ab1..b8bb908 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE FlexibleInstances #-} - module Language.Haskell.GhcMod.Types where import Data.List (intercalate) @@ -39,98 +37,6 @@ defaultOptions = Options { ---------------------------------------------------------------- -type Builder = String -> String - --- | --- --- >>> replace '"' "\\\"" "foo\"bar" "" --- "foo\\\"bar" -replace :: Char -> String -> String -> Builder -replace _ _ [] = id -replace c cs (x:xs) - | x == c = (cs ++) . replace c cs xs - | otherwise = (x :) . replace c cs xs - -inter :: Char -> [Builder] -> Builder -inter _ [] = id -inter c bs = foldr1 (\x y -> x . (c:) . y) bs - -convert :: ToString a => Options -> a -> String -convert opt@Options { outputStyle = LispStyle } x = toLisp opt x "\n" -convert opt@Options { outputStyle = PlainStyle } x - | str == "\n" = "" - | otherwise = str - where - str = toPlain opt x "\n" - -class ToString a where - toLisp :: Options -> a -> Builder - toPlain :: Options -> a -> Builder - -lineSep :: Options -> String -lineSep opt = lsep - where - LineSeparator lsep = lineSeparator opt - --- | --- --- >>> toLisp defaultOptions "fo\"o" "" --- "\"fo\\\"o\"" --- >>> toPlain defaultOptions "foo" "" --- "foo" -instance ToString String where - toLisp opt = quote opt - toPlain opt = replace '\n' (lineSep opt) - --- | --- --- >>> toLisp defaultOptions ["foo", "bar", "ba\"z"] "" --- "(\"foo\" \"bar\" \"ba\\\"z\")" --- >>> toPlain defaultOptions ["foo", "bar", "baz"] "" --- "foo\nbar\nbaz" -instance ToString [String] where - toLisp opt = toSexp1 opt - toPlain opt = inter '\n' . map (toPlain opt) - --- | --- --- >>> let inp = [((1,2,3,4),"foo"),((5,6,7,8),"bar")] :: [((Int,Int,Int,Int),String)] --- >>> toLisp defaultOptions inp "" --- "((1 2 3 4 \"foo\") (5 6 7 8 \"bar\"))" --- >>> toPlain defaultOptions inp "" --- "1 2 3 4 \"foo\"\n5 6 7 8 \"bar\"" -instance ToString [((Int,Int,Int,Int),String)] where - toLisp opt = toSexp2 . map toS - where - toS x = ('(' :) . tupToString opt x . (')' :) - toPlain opt = inter '\n' . map (tupToString opt) - -toSexp1 :: Options -> [String] -> Builder -toSexp1 opt ss = ('(' :) . inter ' ' (map (quote opt) ss) . (')' :) - -toSexp2 :: [Builder] -> Builder -toSexp2 ss = ('(' :) . (inter ' ' ss) . (')' :) - -tupToString :: Options -> ((Int,Int,Int,Int),String) -> Builder -tupToString opt ((a,b,c,d),s) = (show a ++) . (' ' :) - . (show b ++) . (' ' :) - . (show c ++) . (' ' :) - . (show d ++) . (' ' :) - . quote opt s -- fixme: quote is not necessary - -quote :: Options -> String -> Builder -quote opt str = ("\"" ++) . (quote' str ++) . ("\"" ++) - where - lsep = lineSep opt - quote' [] = [] - quote' (x:xs) - | x == '\n' = lsep ++ quote' xs - | x == '\\' = "\\\\" ++ quote' xs - | x == '"' = "\\\"" ++ quote' xs - | otherwise = x : quote' xs - ----------------------------------------------------------------- - -- | The environment where this library is used. data Cradle = Cradle { -- | The directory where this library is executed. diff --git a/ghc-mod.cabal b/ghc-mod.cabal index bfc2659..81ec2e9 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -61,6 +61,7 @@ Library Language.Haskell.GhcMod.CabalConfig Language.Haskell.GhcMod.Cabal16 Language.Haskell.GhcMod.Cabal18 + Language.Haskell.GhcMod.Convert Language.Haskell.GhcMod.Check Language.Haskell.GhcMod.Cradle Language.Haskell.GhcMod.Debug