leksah-0.4: src/IDE/SpecialEditors.hs
--
-- | Special Editors
--
module IDE.SpecialEditors (
packageEditor
, testedWidthEditor
, compilerFlavorEditor
, versionRangeEditor
, versionEditor
, dependencyEditor
, dependenciesEditor
, filesEditor
, stringsEditor
, extensionsEditor
, panePathEditor
, libraryEditor
, executablesEditor
, modulesEditor
, styleEditor
, Library'(..)
, Executable'(..)
) where
import Graphics.UI.Editor.Simple (intEditor,genericEditor,staticListEditor,comboSelectionEditor,stringEditor,fileEditor)
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as New
import Graphics.UI.Gtk.SourceView (sourceStyleSchemeManagerGetSchemeIds)
import Graphics.UI.Gtk.SourceView (sourceStyleSchemeManagerNew)
import Distribution.ModuleName (ModuleName(..))
import Data.List (sort)
import Distribution.Text (simpleParse,display)
import Control.Monad.Reader
import Distribution.PackageDescription
import Distribution.Package
import Distribution.Compiler
import Distribution.Version
import Language.Haskell.Extension
import IDE.Core.State hiding (packageId)
import Graphics.UI.Editor.Basics
import Graphics.UI.Editor.Composite
import Graphics.UI.Editor.Parameters
import Default
import MyMissing
packageEditor :: Editor PackageIdentifier
packageEditor para noti = do
(wid,inj,ext) <- pairEditor
(stringEditor (\s -> not (null s)), paraName <<<- ParaName "Name" $ emptyParams)
(versionEditor, paraName <<<- ParaName "Version" $ emptyParams)
(paraDirection <<<- ParaDirection Horizontal
$ paraShadow <<<- ParaShadow ShadowIn
$ para) noti
let pinj (PackageIdentifier (PackageName n) v) = inj (n,v)
let pext = do
mbp <- ext
case mbp of
Nothing -> return Nothing
Just (n,v) -> do
if null n
then return Nothing
else return (Just $PackageIdentifier (PackageName n) v)
return (wid,pinj,pext)
testedWidthEditor :: Editor [(CompilerFlavor, VersionRange)]
testedWidthEditor para = do
multisetEditor
(ColumnDescr True [("Compiler Flavor",\(cv,_) -> [New.cellText := show cv])
,("Version Range",\(_,vr) -> [New.cellText := display vr])])
(pairEditor
(compilerFlavorEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams)
(versionRangeEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams),
(paraDirection <<<- (ParaDirection Vertical) $ emptyParams))
para
compilerFlavorEditor :: Editor CompilerFlavor
compilerFlavorEditor para noti = do
noti2 <- emptyNotifier
noti3 <- emptyNotifier
(wid,inj,ext) <- eitherOrEditor
(comboSelectionEditor flavors , paraName <<<- (ParaName "Select compiler") $ emptyParams)
(stringEditor (\s -> not (null s)), paraName <<<- (ParaName "Specify compiler") $ emptyParams)
"Other"
(paraName <<<- ParaName "Select" $ para)
noti
let cfinj comp = case comp of
(OtherCompiler str) -> inj (Right "")
other -> inj (Left other)
let cfext = do
mbp <- ext
case mbp of
Nothing -> return Nothing
Just (Right s) -> return (Just $OtherCompiler s)
Just (Left other) -> return (Just other)
return (wid,cfinj,cfext)
where
flavors = [GHC, NHC, Hugs, HBC, Helium, JHC]
versionRangeEditor :: Editor VersionRange
versionRangeEditor para noti = do
(wid,inj,ext) <-
maybeEditor
(eitherOrEditor
(pairEditor
(comboSelectionEditor v1, emptyParams)
(versionEditor, paraName <<<- ParaName "Enter Version" $ emptyParams),
(paraDirection <<<- ParaDirection Vertical)
$ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0)
$ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0)
$ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0)
$ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)
$ emptyParams)
(pairEditor
(comboSelectionEditor v2, emptyParams)
(pairEditor
(versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams)
(versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams),
paraDirection <<<- ParaDirection Vertical $ emptyParams),
paraDirection <<<- ParaDirection Vertical
$ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0)
$ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0)
$ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0)
$ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)
$ emptyParams )
"Complex",paraName <<<- ParaName "Simple"
$ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0)
$ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0)
$ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0)
$ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)
$ emptyParams) False "Any Version"
(paraDirection <<<- ParaDirection Vertical $ para)
noti
let vrinj AnyVersion = inj Nothing
vrinj (ThisVersion v) = inj (Just (Left (ThisVersionS,v)))
vrinj (LaterVersion v) = inj (Just (Left (LaterVersionS,v)))
vrinj (EarlierVersion v) = inj (Just (Left (EarlierVersionS,v)))
vrinj (UnionVersionRanges (ThisVersion v1) (LaterVersion v2)) | v1 == v2
= inj (Just (Left (ThisOrLaterVersionS,v1)))
vrinj (UnionVersionRanges (LaterVersion v1) (ThisVersion v2)) | v1 == v2
= inj (Just (Left (ThisOrLaterVersionS,v1)))
vrinj (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2)) | v1 == v2
= inj (Just (Left (ThisOrEarlierVersionS,v1)))
vrinj (UnionVersionRanges (EarlierVersion v1) (ThisVersion v2)) | v1 == v2
= inj (Just (Left (ThisOrEarlierVersionS,v1)))
vrinj (UnionVersionRanges v1 v2)= inj (Just (Right (UnionVersionRangesS,(v1,v2))))
vrinj (IntersectVersionRanges v1 v2)
= inj (Just (Right (IntersectVersionRangesS,(v1,v2))))
let vrext = do mvr <- ext
case mvr of
Nothing -> return (Just AnyVersion)
Just Nothing -> return (Just AnyVersion)
Just (Just (Left (ThisVersionS,v))) -> return (Just (ThisVersion v))
Just (Just (Left (LaterVersionS,v))) -> return (Just (LaterVersion v))
Just (Just (Left (EarlierVersionS,v))) -> return (Just (EarlierVersion v))
Just (Just (Left (ThisOrLaterVersionS,v))) -> return (Just (orLaterVersion v))
Just (Just (Left (ThisOrEarlierVersionS,v))) -> return (Just (orEarlierVersion v))
Just (Just (Right (UnionVersionRangesS,(v1,v2))))
-> return (Just (UnionVersionRanges v1 v2))
Just (Just (Right (IntersectVersionRangesS,(v1,v2))))
-> return (Just (IntersectVersionRanges v1 v2))
return (wid,vrinj,vrext)
where
v1 = [ThisVersionS,LaterVersionS,ThisOrLaterVersionS,EarlierVersionS,ThisOrEarlierVersionS]
v2 = [UnionVersionRangesS,IntersectVersionRangesS]
data Version1 = ThisVersionS | LaterVersionS | ThisOrLaterVersionS | EarlierVersionS | ThisOrEarlierVersionS
deriving (Eq)
instance Show Version1 where
show ThisVersionS = "This Version"
show LaterVersionS = "Later Version"
show ThisOrLaterVersionS = "This or later Version"
show EarlierVersionS = "Earlier Version"
show ThisOrEarlierVersionS = "This or earlier Version"
data Version2 = UnionVersionRangesS | IntersectVersionRangesS
deriving (Eq)
instance Show Version2 where
show UnionVersionRangesS = "Union Version Ranges"
show IntersectVersionRangesS = "Intersect Version Ranges"
versionEditor :: Editor Version
versionEditor para noti = do
(wid,inj,ext) <- stringEditor (\s -> not (null s)) para noti
let pinj v = inj (display v)
let pext = do
s <- ext
case s of
Nothing -> return Nothing
Just s -> return (simpleParse s)
return (wid, pinj, pext)
dependencyEditor :: [PackageIdentifier] -> Editor Dependency
dependencyEditor packages para noti = do
(wid,inj,ext) <- pairEditor
(comboSelectionEditor (sort (map (display . pkgName) packages))
, paraName <<<- ParaName "Package Name" $ emptyParams)
(versionRangeEditor,paraName <<<- ParaName "Version" $ emptyParams)
(paraDirection <<<- ParaDirection Vertical $ para)
noti
let pinj (Dependency (PackageName s) v) = inj (s,v)
let pext = do
mbp <- ext
case mbp of
Nothing -> return Nothing
Just ("",v) -> return Nothing
Just (s,v) -> return (Just $Dependency (PackageName s) v)
return (wid,pinj,pext)
dependenciesEditor :: [PackageIdentifier] -> Editor [Dependency]
dependenciesEditor packages p noti =
multisetEditor
(ColumnDescr True [("Package",\(Dependency (PackageName str) _) -> [New.cellText := str])
,("Version",\(Dependency _ vers) -> [New.cellText := display vers])])
(dependencyEditor packages,
paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0)
$ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0)
$ emptyParams)
(paraShadow <<<- ParaShadow ShadowIn $
paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0)
$ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0)
$ paraDirection <<<- ParaDirection Vertical
$ paraPack <<<- ParaPack PackGrow
$ p)
noti
filesEditor :: Maybe FilePath -> FileChooserAction -> String -> Editor [FilePath]
filesEditor fp act label p =
multisetEditor
(ColumnDescr False [("",(\row -> [New.cellText := row]))])
(fileEditor fp act label, emptyParams)
(paraShadow <<<- ParaShadow ShadowIn $
paraDirection <<<- ParaDirection Vertical $ p)
stringsEditor :: (String -> Bool) -> Editor [String]
stringsEditor validation p =
multisetEditor
(ColumnDescr False [("",(\row -> [New.cellText := row]))])
(stringEditor validation, emptyParams)
(paraShadow <<<- ParaShadow ShadowIn $ p)
panePathEditor :: Editor StandardPath
panePathEditor = genericEditor
extensionsEditor :: Editor [Extension]
extensionsEditor p = staticListEditor extensionsL (paraMultiSel <<<- ParaMultiSel True $ p)
styleEditor :: Editor (Maybe String)
styleEditor p n = do
styleManager <- sourceStyleSchemeManagerNew
ids <- sourceStyleSchemeManagerGetSchemeIds styleManager
maybeEditor (comboSelectionEditor ids, p) True "Select a special style?" p n
extensionsL :: [Extension]
extensionsL = knownExtensions
{--[
OverlappingInstances
, UndecidableInstances
, IncoherentInstances
, RecursiveDo
, ParallelListComp
, MultiParamTypeClasses
, NoMonomorphismRestriction
, FunctionalDependencies
, Rank2Types
, RankNTypes
, PolymorphicComponents
, ExistentialQuantification
, ScopedTypeVariables
, ImplicitParams
, FlexibleContexts
, FlexibleInstances
, EmptyDataDecls
, CPP
, BangPatterns
, TypeSynonymInstances
, TemplateHaskell
, ForeignFunctionInterface
, Arrows
, Generics
, NoImplicitPrelude
, NamedFieldPuns
, PatternGuards
, GeneralizedNewtypeDeriving
, ExtensibleRecords
, RestrictedTypeSynonyms
, HereDocuments]--}
-- ------------------------------------------------------------
-- * BuildInfos
-- ------------------------------------------------------------
data Library' = Library'{
exposedModules' :: [ModuleName]
, libExposed' :: Bool
, libBuildInfoIdx :: Int}
deriving (Show, Eq)
data Executable' = Executable'{
exeName' :: String
, modulePath' :: FilePath
, buildInfoIdx :: Int}
deriving (Show, Eq)
instance Default Library'
where getDefault = Library' [] getDefault getDefault
instance Default Executable'
where getDefault = Executable' getDefault getDefault getDefault
libraryEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Library'
libraryEditor fp modules numBuildInfos para noti = do
(wid,inj,ext) <-
pairEditor
(modulesEditor modules,
paraName <<<- ParaName "Exposed Modules"
$ paraPack <<<- ParaPack PackGrow
$ paraMinSize <<<- ParaMinSize (-1,500)
$ para)
(buildInfoEditorP numBuildInfos, paraName <<<- ParaName "Build Info"
$ paraPack <<<- ParaPack PackNatural
$ para)
(paraDirection <<<- ParaDirection Vertical
$ paraPack <<<- ParaPack PackGrow
$ emptyParams)
noti
let pinj (Library' em True bi) = inj (map display em,bi)
pinj _ = throwIDE "SpecialEditors>>libraryEditor: No Library"
let pext = do
mbp <- ext
case mbp of
Nothing -> return Nothing
Just (em,bi) -> return (Just $Library' (map (\s -> forceJust (simpleParse s)
"SpecialEditor >> libraryEditor: no parse for moduile name") em) True bi)
return (wid,pinj,pext)
moduleEditor :: [ModuleName] -> Editor String
moduleEditor modules = comboSelectionEditor (map display modules)
modulesEditor :: [ModuleName] -> Editor [String]
modulesEditor modules = staticListEditor (map display modules)
executablesEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Executable']
executablesEditor fp modules countBuildInfo p =
multisetEditor
(ColumnDescr True [("Executable Name",\(Executable' exeName _ _) -> [New.cellText := exeName])
,("Module Path",\(Executable' _ mp _) -> [New.cellText := mp])
,("Build info index",\(Executable' _ _ bii) -> [New.cellText := show (bii + 1)])])
(executableEditor fp modules countBuildInfo,emptyParams)
(paraShadow <<<- ParaShadow ShadowIn $ p)
executableEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Executable'
executableEditor fp modules countBuildInfo para noti = do
(wid,inj,ext) <- pairEditor
(pairEditor
(stringEditor (\s -> not (null s)),
paraName <<<- ParaName "Executable Name"
$ emptyParams)
(stringEditor (\s -> not (null s)),
paraDirection <<<- ParaDirection Vertical
$ paraName <<<- ParaName "File with main function"
$ emptyParams), para)
(buildInfoEditorP countBuildInfo, paraName <<<- ParaName "Build Info"
$ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0)
$ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0)
$ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0)
$ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0)
$ emptyParams)
(paraDirection <<<- ParaDirection Vertical $ para)
noti
let pinj (Executable' s f bi) = inj ((s,f),bi)
let pext = do
mbp <- ext
case mbp of
Nothing -> return Nothing
Just ((s,f),bi) -> return (Just $Executable' s f bi)
return (wid,pinj,pext)
buildInfoEditorP :: Int -> Editor Int
buildInfoEditorP numberOfBuildInfos para noti = do
(wid,inj,ext) <- intEditor (1.0,fromIntegral numberOfBuildInfos,1.0)
(paraName <<<- ParaName "Build Info" $para) noti
let pinj i = inj (i + 1)
let pext = do
mbV <- ext
case mbV of
Nothing -> return Nothing
Just i -> return (Just (i - 1))
return (wid,pinj,pext)
-- ------------------------------------------------------------
-- * (Boring) default values
-- ------------------------------------------------------------
instance Default Version1
where getDefault = ThisVersionS
instance Default Version2
where getDefault = UnionVersionRangesS
instance Default Version
where getDefault = forceJust (simpleParse "0") "SpecialEditors>>default version"
instance Default VersionRange
where getDefault = AnyVersion
instance Default CompilerFlavor
where getDefault = GHC
instance Default BuildInfo
where getDefault = emptyBuildInfo
instance Default Library
where getDefault = Library [] getDefault getDefault
instance Default Dependency
where getDefault = Dependency getDefault getDefault
instance Default Executable
where getDefault = Executable getDefault getDefault getDefault
instance Default PackageName
where getDefault = PackageName getDefault