hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move `convert` to it's own module.

This commit is contained in:
Daniel Gröber 2014-05-12 00:40:00 +02:00
parent f1535efcf2
commit ebfb740a2e
12 changed files with 114 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Language/Haskell/GhcMod/Browse.hs
View File

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

103
Language/Haskell/GhcMod/Convert.hs Normal file
View File

@ -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
----------------------------------------------------------------

1
Language/Haskell/GhcMod/Debug.hs
View File

@ -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
----------------------------------------------------------------

1
Language/Haskell/GhcMod/Find.hs
View File

@ -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

1
Language/Haskell/GhcMod/Flag.hs
View File

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

1
Language/Haskell/GhcMod/Info.hs
View File

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

1
Language/Haskell/GhcMod/Lang.hs
View File

@ -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.

1
Language/Haskell/GhcMod/Lint.hs
View File

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

1
Language/Haskell/GhcMod/List.hs
View File

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

3
Language/Haskell/GhcMod/Logger.hs
View File

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

94
Language/Haskell/GhcMod/Types.hs
View File

@ -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.

1
ghc-mod.cabal
View File

@ -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