leksah-0.1: src/IDE/SpecialEditors.hs
--
-- | Special Editors
--
module IDE.SpecialEditors (
packageEditor
, testedWidthEditor
, compilerFlavorEditor
, versionRangeEditor
, versionEditor
, dependencyEditor
, dependenciesEditor
, filesEditor
, stringsEditor
, extensionsEditor
, panePathEditor
) where
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as New
import Control.Monad.Reader
import Distribution.PackageDescription
import Distribution.Package
import Data.List(filter)
import Distribution.Compiler
import Distribution.Version
import Text.ParserCombinators.ReadP(readP_to_S)
import Language.Haskell.Extension
import IDE.Core.State
import IDE.Framework.EditorBasics
import IDE.Framework.SimpleEditors
import IDE.Framework.CompositeEditors
import IDE.Framework.Parameters
import IDE.Utils.Default
packageEditor :: Editor PackageIdentifier
packageEditor para = do
(wid,inj,ext,notif) <- pairEditor
(stringEditor, paraName <<<- ParaName "Name" $ emptyParams)
(versionEditor, paraName <<<- ParaName "Version" $ emptyParams)
(paraDirection <<<- ParaDirection Horizontal
$ paraShadow <<<- ParaShadow ShadowIn
$ para)
let pinj (PackageIdentifier 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 n v)
return (wid,pinj,pext,notif)
testedWidthEditor :: Editor [(CompilerFlavor, VersionRange)]
testedWidthEditor para = do
multisetEditor
(ColumnDescr False [("Compiler Flavor",\(cv,_) -> [New.cellText := show cv])
,("Version Range",\(_,vr) -> [New.cellText := showVersionRange vr])])
(pairEditor
(compilerFlavorEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams)
(versionRangeEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams),
(paraDirection <<<- (ParaDirection Vertical) $ emptyParams))
para
compilerFlavorEditor :: Editor CompilerFlavor
compilerFlavorEditor para = do
(wid,inj,ext,notif) <- eitherOrEditor
(staticSelectionEditor flavors, paraName <<<- (ParaName "Select compiler") $ emptyParams)
(stringEditor, paraName <<<- (ParaName "Specify compiler") $ emptyParams)
"Other"
(paraName <<<- ParaName "Select" $ para)
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,notif)
where
flavors = [GHC, NHC, Hugs, HBC, Helium, JHC]
versionRangeEditor :: Editor VersionRange
versionRangeEditor para = do
(wid,inj,ext,notif) <-
maybeEditor
(eitherOrEditor
(pairEditor
(staticSelectionEditor v1, emptyParams)
(versionEditor, paraName <<<- ParaName "Enter Version" $ emptyParams),
(paraDirection <<<- ParaDirection Vertical)
$ paraName <<<- ParaName "Simple Version Range"
$ emptyParams)
(pairEditor
(staticSelectionEditor v2, emptyParams)
(pairEditor
(versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams)
(versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams),
paraDirection <<<- ParaDirection Vertical $ emptyParams),
paraDirection <<<- ParaDirection Vertical
$ paraName <<<- ParaName "Complex Version Range"
$ emptyParams)
"Complex",paraName <<<- ParaName "Simple"
$ emptyParams) False "Any Version"
(paraDirection <<<- ParaDirection Vertical $ para)
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,notif)
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 = do
(wid,inj,ext,notiRef) <- stringEditor para
let pinj v = inj (showVersion v)
let pext = do
s <- ext
case s of
Nothing -> return Nothing
Just s -> do
let l = filter (\(h,t) -> null t) (readP_to_S parseVersion s)
if null l then
return Nothing
else return (Just (fst $head l))
return (wid, pinj, pext, notiRef)
dependencyEditor :: Editor Dependency
dependencyEditor para = do
(wid,inj,ext,notif) <- pairEditor
(stringEditor,paraName <<<- ParaName "Package Name" $ emptyParams)
(versionRangeEditor,paraName <<<- ParaName "Version" $ emptyParams)
(paraDirection <<<- ParaDirection Vertical $ para)
let pinj (Dependency 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 s v)
return (wid,pinj,pext,notif)
dependenciesEditor :: Editor [Dependency]
dependenciesEditor p =
multisetEditor
(ColumnDescr True [("Package",\(Dependency str _) -> [New.cellText := str])
,("Version",\(Dependency _ vers) -> [New.cellText := showVersionRange vers])])
(dependencyEditor,emptyParams)
(paraShadow <<<- ParaShadow ShadowIn $ p)
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 $ p)
stringsEditor :: Editor [String]
stringsEditor p =
multisetEditor
(ColumnDescr False [("",(\row -> [New.cellText := row]))])
(stringEditor, emptyParams)
(paraShadow <<<- ParaShadow ShadowIn $ p)
panePathEditor :: Editor StandardPath
panePathEditor = staticSelectionEditor [LeftTop,LeftBottom,RightTop,RightBottom]
extensionsEditor :: Editor [Extension]
extensionsEditor = staticMultiselectionEditor extensionsL
extensionsL :: [Extension]
extensionsL = [
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]
-- ------------------------------------------------------------
-- * (Boring) default values
-- ------------------------------------------------------------
instance Default Version1
where getDefault = ThisVersionS
instance Default Version2
where getDefault = UnionVersionRangesS
instance Default Version
where getDefault = let version = (let l = (readP_to_S parseVersion) "0"
in if null l
then throwIDE "verion parser failed"
else fst $head l)
in 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
instance Default Dependency
where getDefault = Dependency getDefault getDefault
instance Default Executable
where getDefault = Executable getDefault getDefault getDefault