mirrors/IHaskell
1
0
Fork 0
mirror of https://github.com/IHaskell/IHaskell.git synced 2025-04-13 01:46:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fix formatting with newer hindent

Browse Source
This commit is contained in:
Andrew Gibiansky 2015-08-25 16:54:05 -07:00
parent ad66ac8638
commit 62b6c556b0
21 changed files with 649 additions and 410 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

13
ghc-parser/Setup.hs
View File

@ -1,8 +1,7 @@
import Distribution.Simple
import System.Cmd
import Distribution.Simple
import System.Cmd
main = defaultMainWithHooks simpleUserHooks{
preConf = \args confFlags -> do
system "./build-parser.sh"
preConf simpleUserHooks args confFlags
}
main = defaultMainWithHooks
simpleUserHooks { preConf = \args confFlags -> do
system "./build-parser.sh"
preConf simpleUserHooks args confFlags }

3
ihaskell-display/ihaskell-aeson/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-basic/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-blaze/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-charts/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-diagrams/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-hatex/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-juicypixels/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-magic/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-parsec/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-plot/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-rlangqq/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-static-canvas/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

3
ihaskell-display/ihaskell-widgets/Setup.hs
View File

@ -1,2 +1,3 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

17
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Common.hs
View File

@ -4,14 +4,15 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module IHaskell.Display.Widgets.Common where
import Data.Aeson
import Data.Aeson.Types (emptyObject)
import Data.Text (pack, Text)
import Data.Aeson
import Data.Aeson.Types (emptyObject)
import Data.Text (pack, Text)
import IHaskell.Display (IHaskellWidget)
import IHaskell.Eval.Widgets (widgetSendClose)
import IHaskell.Display (IHaskellWidget)
import IHaskell.Eval.Widgets (widgetSendClose)
import qualified IHaskell.Display.Widgets.Singletons as S
@ -91,7 +92,8 @@ pattern SelectedIndex = S.SSelectedIndex
closeWidget :: IHaskellWidget w => w -> IO ()
closeWidget w = widgetSendClose w emptyObject
newtype StrInt = StrInt Integer deriving (Num, Ord, Eq, Enum)
newtype StrInt = StrInt Integer
deriving (Num, Ord, Eq, Enum)
instance ToJSON StrInt where
toJSON (StrInt x) = toJSON . pack $ show x
@ -205,7 +207,8 @@ instance ToJSON ImageFormatValue where
toJSON = toJSON . pack . show
-- | Options for selection widgets.
data SelectionOptions = OptionLabels [Text] | OptionDict [(Text, Text)]
data SelectionOptions = OptionLabels [Text]
| OptionDict [(Text, Text)]
-- | Orientation values.
data OrientationValue = HorizontalOrientation

83
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Interactive.hs
View File

@ -10,18 +10,13 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternSynonyms #-}
module IHaskell.Display.Widgets.Interactive (
interactive,
uncurryHList,
Rec (..),
Argument (..),
) where
module IHaskell.Display.Widgets.Interactive (interactive, uncurryHList, Rec(..), Argument(..)) where
import Data.Text
import Data.Proxy
import Data.Vinyl.Core
import Data.Vinyl.Functor (Identity (..), Const (..))
import Data.Vinyl.Functor (Identity(..), Const(..))
import Data.Vinyl.Derived (HList)
import Data.Vinyl.Lens (type (∈))
import Data.Vinyl.TypeLevel (RecAll)
@ -39,35 +34,49 @@ import IHaskell.Display.Widgets.Int.BoundedInt.IntSlider
import IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider
import IHaskell.Display.Widgets.Output
data WidgetConf a where
WidgetConf :: (RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs, FromWidget a)
=> WrappedWidget (SuitableWidget a) (SuitableHandler a) (SuitableField a) a
-> WidgetConf a
WidgetConf ::
(RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs,
FromWidget a) =>
WrappedWidget (SuitableWidget a) (SuitableHandler a)
(SuitableField a)
a
-> WidgetConf a
newtype WrappedConstructor a = WrappedConstructor {
wrappedConstructor :: IO (IPythonWidget (SuitableWidget a))
}
newtype WrappedConstructor a =
WrappedConstructor
{ wrappedConstructor :: IO (IPythonWidget (SuitableWidget a)) }
type family WithTypes (ts :: [*]) (r :: *) :: * where
WithTypes '[] r = r
WithTypes (x ': xs) r = (x -> WithTypes xs r)
WithTypes '[] r = r
WithTypes (x ': xs) r = (x -> WithTypes xs r)
uncurryHList :: WithTypes ts r -> HList ts -> r
uncurryHList f RNil = f
uncurryHList f (Identity x :& xs) = uncurryHList (f x) xs
-- Consistent type variables are required to make things play nicely with vinyl
data Constructor a where
Constructor :: RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs
=> IO (IPythonWidget (SuitableWidget a)) -> Constructor a
Constructor ::
RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs =>
IO (IPythonWidget (SuitableWidget a)) -> Constructor a
newtype Getter a = Getter (IPythonWidget (SuitableWidget a) -> IO a)
newtype EventSetter a = EventSetter (IPythonWidget (SuitableWidget a) -> IO () -> IO ())
newtype Initializer a = Initializer (IPythonWidget (SuitableWidget a) -> Argument a -> IO ())
newtype Trigger a = Trigger (IPythonWidget (SuitableWidget a) -> IO ())
data RequiredWidget a where
RequiredWidget :: RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs
=> IPythonWidget (SuitableWidget a)
-> RequiredWidget a
RequiredWidget ::
RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs =>
IPythonWidget (SuitableWidget a) -> RequiredWidget a
-- Zipping vinyl records in various ways
applyGetters :: Rec Getter ts -> Rec RequiredWidget ts -> IO (HList ts)
@ -108,8 +117,9 @@ createWidget :: Constructor a -> IO (RequiredWidget a)
createWidget (Constructor con) = fmap RequiredWidget con
mkChildren :: Rec RequiredWidget a -> [ChildWidget]
mkChildren widgets = let childRecord = rmap (\(RequiredWidget w) -> Const (ChildWidget w)) widgets
in recordToList childRecord
mkChildren widgets =
let childRecord = rmap (\(RequiredWidget w) -> Const (ChildWidget w)) widgets
in recordToList childRecord
class MakeConfs (ts :: [*]) where
mkConfs :: proxy ts -> Rec WidgetConf ts
@ -122,13 +132,13 @@ instance (FromWidget t, MakeConfs ts) => MakeConfs (t ': ts) where
interactive :: (IHaskellDisplay r, MakeConfs ts)
=> (HList ts -> r) -> Rec Argument ts -> IO FlexBox
interactive func = let confs = mkConfs Proxy
in liftToWidgets func confs
interactive func =
let confs = mkConfs Proxy
in liftToWidgets func confs
-- | Transform a function (HList ts -> r) to one which:
-- 1) Uses widgets to accept the arguments
-- 2) Accepts initial values for the arguments
-- 3) Creates a compound FlexBox widget with an embedded OutputWidget for display
-- | Transform a function (HList ts -> r) to one which: 1) Uses widgets to accept the arguments 2)
-- Accepts initial values for the arguments 3) Creates a compound FlexBox widget with an embedded
-- OutputWidget for display
liftToWidgets :: IHaskellDisplay r
=> (HList ts -> r) -> Rec WidgetConf ts -> Rec Argument ts -> IO FlexBox
liftToWidgets func rc initvals = do
@ -154,7 +164,6 @@ liftToWidgets func rc initvals = do
-- Set initial values for all widgets
setInitialValues initializers widgets initvals
-- applyValueSetters valueSetters widgets $ getList defvals
setField out Width 500
setField bx Orientation VerticalOrientation
@ -164,10 +173,14 @@ liftToWidgets func rc initvals = do
return bx
data WrappedWidget w h f a where
WrappedWidget :: (FieldType h ~ IO (), FieldType f ~ a, h ∈ WidgetFields w, f ∈ WidgetFields w,
ToPairs (Attr h), IHaskellWidget (IPythonWidget w), ToPairs (Attr f))
=> IO (IPythonWidget w) -> S.SField h -> S.SField f -> WrappedWidget w h f a
WrappedWidget ::
(FieldType h ~ IO (), FieldType f ~ a, h ∈ WidgetFields w,
f ∈ WidgetFields w, ToPairs (Attr h),
IHaskellWidget (IPythonWidget w), ToPairs (Attr f)) =>
IO (IPythonWidget w) ->
S.SField h -> S.SField f -> WrappedWidget w h f a
construct :: WrappedWidget w h f a -> IO (IPythonWidget w)
construct (WrappedWidget cons _ _) = cons
@ -212,7 +225,8 @@ instance FromWidget Integer where
type SuitableWidget Integer = IntSliderType
type SuitableHandler Integer = S.ChangeHandler
type SuitableField Integer = S.IntValue
data Argument Integer = IntVal Integer | IntRange (Integer, Integer, Integer)
data Argument Integer = IntVal Integer
| IntRange (Integer, Integer, Integer)
wrapped = WrappedWidget mkIntSlider ChangeHandler IntValue
initializer w (IntVal int) = setField w IntValue int
initializer w (IntRange (v, l, u)) = do
@ -224,7 +238,8 @@ instance FromWidget Double where
type SuitableWidget Double = FloatSliderType
type SuitableHandler Double = S.ChangeHandler
type SuitableField Double = S.FloatValue
data Argument Double = FloatVal Double | FloatRange (Double, Double, Double)
data Argument Double = FloatVal Double
| FloatRange (Double, Double, Double)
wrapped = WrappedWidget mkFloatSlider ChangeHandler FloatValue
initializer w (FloatVal d) = setField w FloatValue d
initializer w (FloatRange (v, l, u)) = do

9
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Singletons.hs
View File

@ -5,12 +5,15 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
module IHaskell.Display.Widgets.Singletons where
import Data.Singletons.TH
import Data.Singletons.TH
-- Widget properties
singletons [d|
singletons
[d|
data Field = ViewModule
| ViewName
| MsgThrottle
@ -83,4 +86,4 @@ singletons [d|
| Titles
| SelectedIndex
deriving (Eq, Ord, Show)
|]
|]

858
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs
View File

File diff suppressed because it is too large Load Diff

26
src/IHaskell/Eval/Evaluate.hs
View File

@ -136,6 +136,7 @@ requiredGlobalImports =
, "import qualified System.IO as IHaskellSysIO"
, "import qualified Language.Haskell.TH as IHaskellTH"
]
ihaskellGlobalImports :: [String]
ihaskellGlobalImports =
[ "import IHaskell.Display()"
@ -146,7 +147,8 @@ ihaskellGlobalImports =
-- | Run an interpreting action. This is effectively runGhc with initialization and importing. First
-- argument indicates whether `stdin` is handled specially, which cannot be done in a testing
-- environment. The argument passed to the action indicates whether Haskell support libraries are available.
-- environment. The argument passed to the action indicates whether Haskell support libraries are
-- available.
interpret :: String -> Bool -> (Bool -> Interpreter a) -> IO a
interpret libdir allowedStdin action = runGhc (Just libdir) $ do
-- If we're in a sandbox, add the relevant package database
@ -177,8 +179,8 @@ packageIdString' dflags = packageKeyPackageIdString dflags
#else
packageIdString' dflags = packageIdString
#endif
-- | Initialize our GHC session with imports and a value for 'it'.
-- Return whether the IHaskell support libraries are available.
-- | Initialize our GHC session with imports and a value for 'it'. Return whether the IHaskell
-- support libraries are available.
initializeImports :: Interpreter Bool
initializeImports = do
-- Load packages that start with ihaskell-*, aren't just IHaskell, and depend directly on the right
@ -202,9 +204,9 @@ initializeImports = do
guard (iHaskellPkgName `isPrefixOf` idString)
displayPkgs = [pkgName | pkgName <- packageNames
, Just (x:_) <- [stripPrefix initStr pkgName]
, pkgName `notElem` broken
, isAlpha x]
, Just (x:_) <- [stripPrefix initStr pkgName]
, pkgName `notElem` broken
, isAlpha x]
hasIHaskellPackage = not $ null $ filter (== iHaskellPkgName) packageNames
@ -228,8 +230,8 @@ initializeImports = do
-- Import modules.
imports <- mapM parseImportDecl $ requiredGlobalImports ++ if hasIHaskellPackage
then ihaskellGlobalImports ++ displayImports
else []
then ihaskellGlobalImports ++ displayImports
else []
setContext $ map IIDecl $ implicitPrelude : imports
-- Set -fcontext-stack to 100 (default in ghc-7.10). ghc-7.8 uses 20, which is too small.
@ -318,8 +320,8 @@ evaluate kernelState code output widgetHandler = do
-- Get displayed channel outputs. Merge them with normal display outputs.
dispsMay <- if supportLibrariesAvailable state
then extractValue "IHaskell.Display.displayFromChan" >>= liftIO
else return Nothing
then extractValue "IHaskell.Display.displayFromChan" >>= liftIO
else return Nothing
let result =
case dispsMay of
Nothing -> evalResult evalOut
@ -336,8 +338,8 @@ evaluate kernelState code output widgetHandler = do
-- Handle the widget messages
newState <- if supportLibrariesAvailable state
then flushWidgetMessages tempState tempMsgs widgetHandler
else return tempState
then flushWidgetMessages tempState tempMsgs widgetHandler
else return tempState
case evalStatus evalOut of
Success -> runUntilFailure newState rest

11
verify_formatting.py
View File

@ -44,21 +44,16 @@ except:
# Find all the source files
sources = []
widget_dir = "ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets"
for source_dir in ["src", "ipython-kernel", "ihaskell-display"]:
for root, dirnames, filenames in os.walk(source_dir):
# Skip cabal dist directories
if "dist" in root:
continue
# Ignore IHaskellPrelude.hs, it uses CPP in weird places
ignored_files = ["IHaskellPrelude.hs"]
for filename in filenames:
if "ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets" in root:
# Ignoring files from ihaskell-widgets
# They cause issues with hindent, due to promoted types
ignored_files = ["Types.hs", "Common.hs", "Singletons.hs", "Interactive.hs"]
else:
# Take Haskell files, but ignore the Cabal Setup.hs
# Also ignore IHaskellPrelude.hs, it uses CPP in weird places
ignored_files = ["Setup.hs", "IHaskellPrelude.hs", "Evaluate.hs"]
if filename.endswith(".hs") and filename not in ignored_files:
sources.append(os.path.join(root, filename))