{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Hhp.Types where
import Control.Monad.Catch (catch)
import GHC (Ghc)
import Control.Exception (IOException)
import Control.Applicative (Alternative(..))
import Data.List (intercalate)
data OutputStyle = LispStyle
| PlainStyle
newtype LineSeparator = LineSeparator String
data Options = Options {
Options -> OutputStyle
outputStyle :: OutputStyle
, Options -> [String]
hlintOpts :: [String]
, Options -> [String]
ghcOpts :: [GHCOption]
, Options -> Bool
operators :: Bool
, Options -> Bool
detailed :: Bool
, Options -> Bool
qualified :: Bool
, Options -> LineSeparator
lineSeparator :: LineSeparator
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options {
outputStyle :: OutputStyle
outputStyle = OutputStyle
PlainStyle
, hlintOpts :: [String]
hlintOpts = []
, ghcOpts :: [String]
ghcOpts = []
, operators :: Bool
operators = Bool
False
, detailed :: Bool
detailed = Bool
False
, qualified :: Bool
qualified = Bool
False
, lineSeparator :: LineSeparator
lineSeparator = String -> LineSeparator
LineSeparator String
"\0"
}
type Builder = String -> String
replace :: Char -> String -> String -> Builder
replace :: Char -> String -> String -> Builder
replace Char
_ String
_ [] = forall a. a -> a
id
replace Char
c String
cs (Char
x:String
xs)
| Char
x forall a. Eq a => a -> a -> Bool
== Char
c = (String
cs forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String -> Builder
replace Char
c String
cs String
xs
| Bool
otherwise = (Char
x forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String -> Builder
replace Char
c String
cs String
xs
inter :: Char -> [Builder] -> Builder
inter :: Char -> [Builder] -> Builder
inter Char
_ [] = forall a. a -> a
id
inter Char
c [Builder]
bs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Builder
x Builder
y -> Builder
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
cforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder
y) [Builder]
bs
convert :: ToString a => Options -> a -> String
convert :: forall a. ToString a => Options -> a -> String
convert opt :: Options
opt@Options { outputStyle :: Options -> OutputStyle
outputStyle = OutputStyle
LispStyle } a
x = forall a. ToString a => Options -> a -> Builder
toLisp Options
opt a
x String
"\n"
convert opt :: Options
opt@Options { outputStyle :: Options -> OutputStyle
outputStyle = OutputStyle
PlainStyle } a
x
| String
str forall a. Eq a => a -> a -> Bool
== String
"\n" = String
""
| Bool
otherwise = String
str
where
str :: String
str = forall a. ToString a => Options -> a -> Builder
toPlain Options
opt a
x String
"\n"
class ToString a where
toLisp :: Options -> a -> Builder
toPlain :: Options -> a -> Builder
lineSep :: Options -> String
lineSep :: Options -> String
lineSep Options
opt = String
lsep
where
LineSeparator String
lsep = Options -> LineSeparator
lineSeparator Options
opt
instance ToString String where
toLisp :: Options -> String -> Builder
toLisp Options
opt = Options -> String -> Builder
quote Options
opt
toPlain :: Options -> String -> Builder
toPlain Options
opt = Char -> String -> String -> Builder
replace Char
'\n' (Options -> String
lineSep Options
opt)
instance ToString [String] where
toLisp :: Options -> [String] -> Builder
toLisp Options
opt = Options -> [String] -> Builder
toSexp1 Options
opt
toPlain :: Options -> [String] -> Builder
toPlain Options
opt = Char -> [Builder] -> Builder
inter Char
'\n' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToString a => Options -> a -> Builder
toPlain Options
opt)
instance ToString [((Int,Int,Int,Int),String)] where
toLisp :: Options -> [((Int, Int, Int, Int), String)] -> Builder
toLisp Options
opt = [Builder] -> Builder
toSexp2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int, Int, Int), String) -> Builder
toS
where
toS :: ((Int, Int, Int, Int), String) -> Builder
toS ((Int, Int, Int, Int), String)
x = (Char
'(' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ((Int, Int, Int, Int), String) -> Builder
tupToString Options
opt ((Int, Int, Int, Int), String)
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' forall a. a -> [a] -> [a]
:)
toPlain :: Options -> [((Int, Int, Int, Int), String)] -> Builder
toPlain Options
opt = Char -> [Builder] -> Builder
inter Char
'\n' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Options -> ((Int, Int, Int, Int), String) -> Builder
tupToString Options
opt)
toSexp1 :: Options -> [String] -> Builder
toSexp1 :: Options -> [String] -> Builder
toSexp1 Options
opt [String]
ss = (Char
'(' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Builder] -> Builder
inter Char
' ' (forall a b. (a -> b) -> [a] -> [b]
map (Options -> String -> Builder
quote Options
opt) [String]
ss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' forall a. a -> [a] -> [a]
:)
toSexp2 :: [Builder] -> Builder
toSexp2 :: [Builder] -> Builder
toSexp2 [Builder]
ss = (Char
'(' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Builder] -> Builder
inter Char
' ' [Builder]
ss forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' forall a. a -> [a] -> [a]
:)
tupToString :: Options -> ((Int,Int,Int,Int),String) -> Builder
tupToString :: Options -> ((Int, Int, Int, Int), String) -> Builder
tupToString Options
opt ((Int
a,Int
b,Int
c,Int
d),String
s) = (forall a. Show a => a -> String
show Int
a forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> String
show Int
b forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> String
show Int
c forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> String
show Int
d forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> Builder
quote Options
opt String
s
quote :: Options -> String -> Builder
quote :: Options -> String -> Builder
quote Options
opt String
str = (String
"\"" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
quote' String
str forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"\"" forall a. [a] -> [a] -> [a]
++)
where
lsep :: String
lsep = Options -> String
lineSep Options
opt
quote' :: Builder
quote' [] = []
quote' (Char
x:String
xs)
| Char
x forall a. Eq a => a -> a -> Bool
== Char
'\n' = String
lsep forall a. [a] -> [a] -> [a]
++ Builder
quote' String
xs
| Char
x forall a. Eq a => a -> a -> Bool
== Char
'\\' = String
"\\\\" forall a. [a] -> [a] -> [a]
++ Builder
quote' String
xs
| Char
x forall a. Eq a => a -> a -> Bool
== Char
'"' = String
"\\\"" forall a. [a] -> [a] -> [a]
++ Builder
quote' String
xs
| Bool
otherwise = Char
x forall a. a -> [a] -> [a]
: Builder
quote' String
xs
data Cradle = Cradle {
Cradle -> String
cradleCurrentDir :: FilePath
, Cradle -> String
cradleRootDir :: FilePath
, Cradle -> Maybe String
cradleCabalFile :: Maybe FilePath
, Cradle -> [GhcPkgDb]
cradlePkgDbStack :: [GhcPkgDb]
} deriving (Cradle -> Cradle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cradle -> Cradle -> Bool
$c/= :: Cradle -> Cradle -> Bool
== :: Cradle -> Cradle -> Bool
$c== :: Cradle -> Cradle -> Bool
Eq, Int -> Cradle -> Builder
[Cradle] -> Builder
Cradle -> String
forall a.
(Int -> a -> Builder)
-> (a -> String) -> ([a] -> Builder) -> Show a
showList :: [Cradle] -> Builder
$cshowList :: [Cradle] -> Builder
show :: Cradle -> String
$cshow :: Cradle -> String
showsPrec :: Int -> Cradle -> Builder
$cshowsPrec :: Int -> Cradle -> Builder
Show)
data GhcPkgDb = GlobalDb | UserDb | PackageDb String deriving (GhcPkgDb -> GhcPkgDb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcPkgDb -> GhcPkgDb -> Bool
$c/= :: GhcPkgDb -> GhcPkgDb -> Bool
== :: GhcPkgDb -> GhcPkgDb -> Bool
$c== :: GhcPkgDb -> GhcPkgDb -> Bool
Eq, Int -> GhcPkgDb -> Builder
[GhcPkgDb] -> Builder
GhcPkgDb -> String
forall a.
(Int -> a -> Builder)
-> (a -> String) -> ([a] -> Builder) -> Show a
showList :: [GhcPkgDb] -> Builder
$cshowList :: [GhcPkgDb] -> Builder
show :: GhcPkgDb -> String
$cshow :: GhcPkgDb -> String
showsPrec :: Int -> GhcPkgDb -> Builder
$cshowsPrec :: Int -> GhcPkgDb -> Builder
Show)
type GHCOption = String
type IncludeDir = FilePath
type PackageBaseName = String
type PackageVersion = String
type PackageId = String
type Package = (PackageBaseName, PackageVersion, PackageId)
pkgName :: Package -> PackageBaseName
pkgName :: Package -> String
pkgName (String
n,String
_,String
_) = String
n
pkgVer :: Package -> PackageVersion
pkgVer :: Package -> String
pkgVer (String
_,String
v,String
_) = String
v
pkgId :: Package -> PackageId
pkgId :: Package -> String
pkgId (String
_,String
_,String
i) = String
i
showPkg :: Package -> String
showPkg :: Package -> String
showPkg (String
n,String
v,String
_) = forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String
n,String
v]
showPkgId :: Package -> String
showPkgId :: Package -> String
showPkgId (String
n,String
v,String
"") = forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String
n,String
v]
showPkgId (String
n,String
v,String
i) = forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String
n,String
v,String
i]
type Expression = String
type ModuleString = String
data CompilerOptions = CompilerOptions {
CompilerOptions -> [String]
ghcOptions :: [GHCOption]
, CompilerOptions -> [String]
includeDirs :: [IncludeDir]
, CompilerOptions -> [Package]
depPackages :: [Package]
} deriving (CompilerOptions -> CompilerOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerOptions -> CompilerOptions -> Bool
$c/= :: CompilerOptions -> CompilerOptions -> Bool
== :: CompilerOptions -> CompilerOptions -> Bool
$c== :: CompilerOptions -> CompilerOptions -> Bool
Eq, Int -> CompilerOptions -> Builder
[CompilerOptions] -> Builder
CompilerOptions -> String
forall a.
(Int -> a -> Builder)
-> (a -> String) -> ([a] -> Builder) -> Show a
showList :: [CompilerOptions] -> Builder
$cshowList :: [CompilerOptions] -> Builder
show :: CompilerOptions -> String
$cshow :: CompilerOptions -> String
showsPrec :: Int -> CompilerOptions -> Builder
$cshowsPrec :: Int -> CompilerOptions -> Builder
Show)
instance Alternative Ghc where
Ghc a
x <|> :: forall a. Ghc a -> Ghc a -> Ghc a
<|> Ghc a
y = Ghc a
x forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(IOException
_ :: IOException) -> Ghc a
y)
empty :: forall a. Ghc a
empty = forall a. HasCallStack => a
undefined