diff --git a/.gitignore b/.gitignore deleted file mode 100644 --- a/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -dist -*.hi -*.o diff --git a/Graphics/X11/Xft.hsc b/Graphics/X11/Xft.hsc --- a/Graphics/X11/Xft.hsc +++ b/Graphics/X11/Xft.hsc @@ -91,6 +91,7 @@ where import qualified Graphics.X11 as X11 +import qualified Graphics.X11.Xlib.Types as X11 import Codec.Binary.UTF8.String as UTF8 @@ -109,7 +110,6 @@ import Data.Int import Data.Word -import System.IO import System.IO.Unsafe import System.Mem.Weak diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,25 +0,0 @@ -Sindre - programming language for writing simple GUIs -=== - -Sindre is a programming language inspired by Awk that makes it easy to -write simple graphical programs in the spirit of dzen, dmenu, xmobar, -gsmenu and the like. - -Requirements ---- - -A relatively modern (GHC >= 7.x) Haskell setup and a number of -libraries available on Hackage. See 'sindre.cabal' for specifics. -Sindre is developed with POSIX systems in mind and may not run (or be -useful) anywhere else. - -Installation ---- - -Just run 'cabal install' and Cabal should build and install Sindre. - -Documentation ---- - -Nothing yet, unfortunately, but check the examples/ directory for -sample code. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/env runhaskell - -import Distribution.Simple.Setup (CopyDest(..),ConfigFlags(..),BuildFlags(..), - CopyFlags(..),RegisterFlags(..),InstallFlags(..), - defaultRegisterFlags,fromFlagOrDefault,Flag(..), - defaultCopyFlags) -import Distribution.Simple -import Distribution.Simple.LocalBuildInfo (absoluteInstallDirs) -import Distribution.PackageDescription (PackageDescription(..)) -import Distribution.Simple.InstallDirs - (InstallDirs(..)) -import Distribution.Simple.Utils -import Distribution.Verbosity -import Data.List (isPrefixOf) -import Data.Version -import Control.Monad (unless) -import System.Posix -import System.Directory -import System.Info (os) -import System.FilePath - -main = defaultMainWithHooks sindreHooks -sindreHooks = simpleUserHooks { postInst = sindrePostInst - , postCopy = sindrePostCopy } - -sindre = "sindre" - -isWindows :: Bool -isWindows = os == "mingw" -- XXX - -subst :: String -> String -> String -> String -subst t r [] = [] -subst t r s@(c:s') - | t `isPrefixOf` s = r ++ subst t r (drop (length t) s) - | otherwise = c : subst t r s' - -sindrePostInst a (InstallFlags { installPackageDB = db, installVerbosity = v }) = - sindrePostCopy a (defaultCopyFlags { copyDest = Flag NoCopyDest, copyVerbosity = v }) - -sindrePostCopy a (CopyFlags { copyDest = cdf, copyVerbosity = vf }) pd lbi = - do let v = fromFlagOrDefault normal vf - cd = fromFlagOrDefault NoCopyDest cdf - dirs = absoluteInstallDirs pd lbi cd - bin = combine (bindir dirs) - substVersion = subst "VERSION" $ showVersion $ packageVersion $ package pd - unless isWindows $ do - copyFileVerbose v "sinmenu" (bin "sinmenu") - fs <- getFileStatus (bin "sindre") - setFileMode (bin "sinmenu") $ fileMode fs - putStrLn $ "Installing manpage in " ++ mandir dirs - createDirectoryIfMissing True $ mandir dirs `combine` "man1" - withFileContents "sindre.1" $ - writeFileAtomic (mandir dirs `combine` "man1" `combine` "sindre.1") . substVersion - withFileContents "sinmenu.1" $ - writeFileAtomic (mandir dirs `combine` "man1" `combine` "sinmenu.1") . substVersion diff --git a/Sindre/ANSI.hs b/Sindre/ANSI.hs deleted file mode 100644 --- a/Sindre/ANSI.hs +++ /dev/null @@ -1,151 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- | --- Module : Sindre.ANSI --- License : MIT-style (see LICENSE) --- --- Stability : provisional --- Portability : unportable --- --- ANSI backend for Sindre. --- ------------------------------------------------------------------------------ -module Sindre.ANSI( SindreANSIM - , sindreANSI - ) - where - -import Sindre.Sindre -import Sindre.Compiler -import Sindre.Lib -import Sindre.Runtime -import Sindre.Util -import Sindre.Widgets - -import System.Console.ANSI - -import System.Environment -import System.Exit -import System.IO -import System.Posix.Types - -import Control.Arrow(first,second) -import Control.Concurrent -import Control.Applicative -import Control.Exception -import Control.Monad.Reader -import Control.Monad.State -import Data.Bits -import Data.Char hiding (Control) -import Data.Maybe -import Data.List -import qualified Data.ByteString as B -import qualified Data.Map as M -import Data.Monoid -import Data.Ord -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Text.Encoding as E - -import Prelude hiding (catch) - - --- | The read-only configuration of the ANSI backend, created during --- backend initialisation. -data SindreANSIConf = SindreANSIConf { - sindreTerminal :: Handle -- ^ Where we're being displayed. - , sindreVisualOpts :: VisualOpts - -- ^ The default visual options used if no others are specified for - -- a widget. - , sindreEvtVar :: MVar Event - -- ^ Channel through which events are sent by other threads to the - -- Sindre command loop. - } - --- | Sindre backend using ANSI. -newtype SindreANSIM a = SindreANSIM (ReaderT SindreANSIConf (StateT Rectangle IO) a) - deriving ( Functor, Monad, MonadIO, MonadReader SindreANSIConf - , MonadState Rectangle, Applicative) - -runSindreANSI :: SindreANSIM a -> SindreANSIConf -> Rectangle -> IO a -runSindreANSI (SindreANSIM m) = evalStateT . runReaderT m - -instance MonadBackend SindreANSIM where - type BackEvent SindreANSIM = Char - type RootPosition SindreANSIM = () - - redrawRoot = do - (orient, rootwr) <- gets rootWidget - reqs <- compose rootwr - winsize <- back get - let orient' = fromMaybe () orient - rect = fitRect winsize reqs - draw rootwr $ Just rect - return () - - redrawRegion _ = return () - - waitForBackEvent = do - evvar <- back $ asks sindreEvtVar - io $ takeMVar evvar - - getBackEvent = do - io yield - back (io . tryTakeMVar =<< asks sindreEvtVar) - - printVal s = io $ putStr s *> hFlush stdout - -setupTerminal :: IO Handle -setupTerminal = do h <- openFile "/dev/tty" ReadWriteMode - hSetBuffering h NoBuffering - hSetEcho h False - return h - -getKeypress :: Handle -> IO Chord -getKeypress h = (S.empty,) <$> CharKey <$> hGetChar h - -eventReader :: Handle -> MVar Event -> IO () -eventReader h evvar = forever $ (putMVar evvar . KeyPress) =<< getKeypress h - -sindreANSICfg :: IO SindreANSIConf -sindreANSICfg = do - h <- setupTerminal - visopts <- defVisualOpts - evvar <- newEmptyMVar - xlock <- newMVar () - _ <- forkIO $ eventReader h evvar - return SindreANSIConf { sindreTerminal = h - , sindreVisualOpts = visopts - , sindreEvtVar = evvar } - --- | Options regarding visual appearance of widgets (colours and --- fonts). -data VisualOpts = VisualOpts { - foreground :: Color - , background :: Color - , focusForeground :: Color - , focusBackground :: Color - } - -defVisualOpts :: IO VisualOpts -defVisualOpts = pure $ VisualOpts Black White White Blue - --- | Execute Sindre in the ANSI backend. -sindreANSI :: SindreANSIM ExitCode - -- ^ The function returned by - -- 'Sindre.Compiler.compileSindre' after command line - -- options have been given - -> IO ExitCode -sindreANSI start = do - cfg <- sindreANSICfg - rows <- read <$> getEnv "LINES" - cols <- read <$> getEnv "COLUMNS" - runSindreANSI start cfg $ Rectangle 0 0 rows cols diff --git a/Sindre/Compiler.hs b/Sindre/Compiler.hs --- a/Sindre/Compiler.hs +++ b/Sindre/Compiler.hs @@ -53,7 +53,7 @@ import Data.Fixed import Data.List import Data.Maybe -import Data.Traversable(traverse) +import Data.Traversable (for, traverse) import qualified Data.IntMap as IM import qualified Data.Map as M import qualified Data.Text as T @@ -127,7 +127,7 @@ compileError s = do pos <- position <$> asks currentPos error $ pos ++ s -runtimeError :: Compiler m (String -> Execution m a) +runtimeError :: MonadFail m => Compiler m (String -> Execution m a) runtimeError = do pos <- position <$> asks currentPos return $ \s -> fail $ pos ++ s @@ -268,7 +268,7 @@ "Redefinition of built-in function '"++k++"'" _ -> do f' <- compileFunction f return (k, f') - fm' <- flip traverse fm $ \e -> do + fm' <- for fm $ \e -> do e' <- e return $ sindre . e' =<< IM.elems <$> sindre (gets execFrame) begin <- mapM (descend compileStmt) $ programBegin prog @@ -323,7 +323,7 @@ where f wr (NamedEvent evn2 vs (FieldSrc wr2 fn2)) | wr == wr2, evn2 == evn, fn2 `fcmp` fn = return $ Just vs f wr (NamedEvent evn2 vs (ObjectSrc wr2)) - | wr == wr2, evn2 == evn, fn == Nothing = return $ Just vs + | wr == wr2, evn2 == evn, Nothing <- fn = return $ Just vs f _ _ = return Nothing compilePattern (SourcedPattern (GenericSource cn wn fn) evn args) = return (f, wn:args) @@ -331,7 +331,7 @@ | cn==cn2, evn2 == evn, fn2 `fcmp` fn = return $ Just $ Reference wr2 : vs f (NamedEvent evn2 vs (ObjectSrc wr2@(_,cn2,_))) - | cn==cn2, evn2 == evn, fn == Nothing = + | cn==cn2, evn2 == evn, Nothing <- fn = return $ Just $ Reference wr2 : vs f _ = return Nothing @@ -378,7 +378,7 @@ Nothing -> bad "Exit code must be an integer" compileStmt (Expr e) = do e' <- descend compileExpr e - return $ e' >> return () + return $ void e' compileStmt (Return (Just e)) = do e' <- descend compileExpr e return $ doReturn =<< e' @@ -628,7 +628,7 @@ a) deriving ( MonadState (M.Map Identifier Value) , MonadError ParamError - , Monad, Functor, Applicative) + , Monad, MonadFail, Functor, Applicative) -- | @noParam k@ signals that parameter @k@ is missing. noParam :: String -> ConstructorM m a diff --git a/Sindre/Main.hs b/Sindre/Main.hs --- a/Sindre/Main.hs +++ b/Sindre/Main.hs @@ -47,8 +47,6 @@ import qualified Data.Traversable as T import Data.Version (showVersion) -import Prelude hiding (catch) - setupLocale :: IO () setupLocale = do ret <- setLocale LC_ALL Nothing @@ -184,6 +182,7 @@ , ("Input", mkTextField) , ("HList", mkHList) , ("VList", mkVList) + , ("Graph", mkGraph) , ("", mkUndef) ] diff --git a/Sindre/Runtime.hs b/Sindre/Runtime.hs --- a/Sindre/Runtime.hs +++ b/Sindre/Runtime.hs @@ -4,9 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : Sindre.Runtime @@ -118,9 +116,9 @@ -- | Turn a Haskell-typed high-level field description into a -- 'Value'-typed field. -field :: Mold v => FieldDesc s im v -> Field s im +field :: (MonadFail im, Mold v) => FieldDesc s im v -> Field s im field (ReadOnlyField name bgetter) = Field name (unmold <$> bgetter) problem - where problem = fail "Field is read-only" + where problem = const $ fail "Field is read-only" field (ReadWriteField name bgetter bsetter) = Field name (unmold <$> bgetter) setter where setter v = maybe problem bsetter $ mold v @@ -181,17 +179,17 @@ instObject :: NewObject im -> DataSlot im instObject (NewObject o) = ObjectSlot o -callMethodI :: Identifier -> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s) +callMethodI :: MonadFail im => Identifier -> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s) callMethodI m vs k s = case M.lookup m $ objectMethods s of Nothing -> fail "No such method" Just m' -> runObjectM (m' vs) k $ objectState s -getFieldI :: Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s) +getFieldI :: MonadFail im => Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s) getFieldI f k s = case M.lookup f $ objectFields s of Nothing -> fail "No such field" Just f' -> runObjectM (fieldGetter f') k $ objectState s -setFieldI :: Identifier -> Value -> ObjectRef -> Object s im -> Sindre im (Value, s) +setFieldI :: MonadFail im => Identifier -> Value -> ObjectRef -> Object s im -> Sindre im (Value, s) setFieldI f v k s = case M.lookup f $ objectFields s of Nothing -> fail "No such field" Just f' -> runObjectM (setget f') k $ objectState s @@ -234,7 +232,7 @@ } -- | A monad that can be used as the layer beneath 'Sindre'. -class (MonadIO m, Functor m, Applicative m, Mold (RootPosition m)) => MonadBackend m where +class (MonadIO m, MonadFail m, Mold (RootPosition m)) => MonadBackend m where type BackEvent m :: * type RootPosition m :: * redrawRoot :: Sindre m () @@ -252,7 +250,7 @@ (StateT (SindreEnv m) (ContT ExitCode m)) a) - deriving (Functor, Monad, Applicative, MonadCont, + deriving (Functor, Monad, Applicative, MonadFail, MonadCont, MonadState (SindreEnv m), MonadReader (QuitFun m)) instance MonadTrans Sindre where @@ -263,9 +261,11 @@ instance Monoid (Sindre m ()) where mempty = return () - mappend = (>>) mconcat = sequence_ +instance Semigroup (Sindre m ()) where + (<>) = (>>) + -- | @execSindre e m@ executes the action @m@ in environment @e@, -- returning the exit code of @m@. execSindre :: MonadBackend m => SindreEnv m -> Sindre m a -> m ExitCode @@ -284,7 +284,7 @@ -- | @MonadSindre im m@ is the class of monads @m@ that run on top of -- 'Sindre' with backend @im@, and can thus access Sindre -- functionality. -class (MonadBackend im, Monad (m im)) => MonadSindre im m where +class (MonadBackend im, MonadFail (m im), MonadFail im) => MonadSindre im m where -- | Lift a 'Sindre' operation into this monad. sindre :: Sindre im a -> m im a -- | Lift a backend operation into this monad. @@ -295,7 +295,7 @@ sindre = id newtype ObjectM s im a = ObjectM (ReaderT ObjectRef (StateT s (Sindre im)) a) - deriving (Functor, Monad, Applicative, MonadState s, MonadReader ObjectRef) + deriving (Functor, Monad, MonadFail, Applicative, MonadState s, MonadReader ObjectRef) instance MonadBackend im => MonadSindre im (ObjectM o) where sindre = ObjectM . lift . lift @@ -410,20 +410,20 @@ doCont = doJump execCont () newtype Execution m a = Execution (ReaderT (ExecutionEnv m) (Sindre m) a) - deriving (Functor, Monad, Applicative, MonadReader (ExecutionEnv m), MonadCont) + deriving (Functor, Monad, MonadFail, Applicative, MonadReader (ExecutionEnv m), MonadCont) execute :: MonadBackend m => Execution m Value -> Sindre m Value execute m = runReaderT m' env where env = ExecutionEnv { - execReturn = fail "Nowhere to return to" - , execNext = fail "Nowhere to go next" - , execBreak = fail "Not in a loop" - , execCont = fail "Not in a loop" + execReturn = const $ fail "Nowhere to return to" + , execNext = const $ fail "Nowhere to go next" + , execBreak = const $ fail "Not in a loop" + , execCont = const $ fail "Not in a loop" } Execution m' = returnHere m execute_ :: MonadBackend m => Execution m a -> Sindre m () -execute_ m = execute (m *> return (Number 0)) >> return () +execute_ m = void $ execute (m *> return (Number 0)) instance MonadBackend im => MonadSindre im Execution where sindre = Execution . lift diff --git a/Sindre/Sindre.hs b/Sindre/Sindre.hs --- a/Sindre/Sindre.hs +++ b/Sindre/Sindre.hs @@ -66,12 +66,11 @@ ) where -import System.Console.GetOpt +import Sindre.Util -import Control.Applicative +import System.Console.GetOpt import Data.List import qualified Data.Map as M -import Data.Monoid import qualified Data.Set as S import qualified Data.Text as T @@ -88,7 +87,9 @@ instance Monoid Rectangle where mempty = Rectangle 0 0 (-1) (-1) - mappend r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2) + +instance Semigroup Rectangle where + r1@(Rectangle x1 y1 w1 h1) <> r2@(Rectangle x2 y2 w2 h2) | r1 == mempty = r2 | r2 == mempty = r1 | otherwise = Rectangle x' y' (max (x1+w1-x') (x2+w2-x')) @@ -106,10 +107,6 @@ where zipper' a (x:xs) = let (a', x', xs') = f (a, x, xs) in zipper' (x':a') xs' zipper' a [] = reverse a - -divide :: Integral a => a -> a -> [a] -divide total n = map (const c) [0..n-2] ++ [c+r] - where (c,r) = total `quotRem` n -- | @splitHoriz rect dims@ splits @rect@ horizontally into a number -- of non-overlapping equal-width rectangles stacked on top of each diff --git a/Sindre/Util.hs b/Sindre/Util.hs --- a/Sindre/Util.hs +++ b/Sindre/Util.hs @@ -21,6 +21,7 @@ , clamp , mapAccumLM , ifM + , divide ) where import Control.Monad.Trans @@ -96,3 +97,13 @@ ifM :: Monad m => m Bool -> m a -> m a -> m a ifM p t e = do b <- p if b then t else e + +-- | @x `divide` n@ splits the interval @[0..x]@ into @n@ +-- non-overlapping chunks that together form the entire interval. +-- For example: +-- +-- >>> 10 `divide` 3 +-- [3,3,4] +divide :: Integral a => a -> a -> [a] +divide total n = map (const c) [0..n-2] ++ [c+r] + where (c,r) = total `quotRem` n diff --git a/Sindre/Widgets.hs b/Sindre/Widgets.hs --- a/Sindre/Widgets.hs +++ b/Sindre/Widgets.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} @@ -98,7 +99,7 @@ -- | @changeField field m@ applies @m@ to the current value of the -- field @field@, updates @field@ with the value returned by @m@, and -- returns the new value. -changeField :: FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im v +changeField :: MonadFail im => FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im v changeField (ReadWriteField _ getter setter) m = do v' <- m =<< getter setter v' @@ -106,8 +107,8 @@ changeField (ReadOnlyField _ _) _ = fail "Field is read-only" -- | Like 'changeField', but without a return value. -changeField_ :: FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im () -changeField_ f m = changeField f m >> return () +changeField_ :: MonadFail im => FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im () +changeField_ f m = void $ changeField f m -- | @changingFields fields m@ evaluates @m@, then emits field change -- events for those fields whose names are in @fields@ that changed diff --git a/Sindre/X11.hs b/Sindre/X11.hs --- a/Sindre/X11.hs +++ b/Sindre/X11.hs @@ -45,6 +45,7 @@ , mkInStream , mkHList , mkVList + , mkGraph ) where @@ -99,8 +100,6 @@ import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding.Error as E -import Prelude hiding (catch) - fromXRect :: X.Rectangle -> Rectangle fromXRect r = Rectangle { rectX = fi $ rect_x r @@ -191,7 +190,7 @@ -- | Sindre backend using Xlib. newtype SindreX11M a = SindreX11M (ReaderT SindreX11Conf (StateT Surface IO) a) - deriving ( Functor, Monad, MonadIO + deriving ( Functor, Monad, MonadIO, MonadFail , MonadReader SindreX11Conf, MonadState Surface, Applicative) runSindreX11 :: SindreX11M a -> SindreX11Conf -> Surface -> IO a @@ -217,7 +216,7 @@ SindreX11Conf{ sindreDisplay=dpy } <- ask sur <- get io $ copySurface dpy sur rects >> sync dpy False - + waitForBackEvent = do back unlockX evvar <- back $ asks sindreEvtVar @@ -225,8 +224,8 @@ ev <- evm back lockX maybe waitForBackEvent return ev - - getBackEvent = do + + getBackEvent = back (io . tryTakeMVar =<< asks sindreEvtVar) >>= fromMaybe (return Nothing) @@ -308,7 +307,11 @@ fi (rect_width rect) + rect_x rect > fi x && fi y >= rect_y rect && fi (rect_height rect) + rect_y rect > fi y - fromJust <$> find contains <$> getScreenInfo dpy + sinfo <- getScreenInfo dpy + case (find contains sinfo, sinfo) of + (Just r, _) -> return r + (Nothing, r:_) -> return r -- When does this happen? + (Nothing, []) -> error "Cannot find any screens" where windowWithPointer = do (_, _, _, x, y, _, _, _) <- queryPointer dpy rootw return (x,y) @@ -382,10 +385,10 @@ , ev_width = w, ev_height = h }) = do back $ do onsurface <- (==win) <$> gets surfaceWindow when onsurface $ do - sur <- (pure resizeSurface - <*> asks sindreDisplay - <*> asks sindreXftMgr <*> get - <*> pure (Rectangle 0 0 (fi w) (fi h))) + sur <- pure resizeSurface + <*> asks sindreDisplay + <*> asks sindreXftMgr <*> get + <*> pure (Rectangle 0 0 (fi w) (fi h)) put =<< io sur redrawRoot >> return Nothing processX11Event (_, _, AnyEvent { ev_event_type = t }) @@ -416,12 +419,12 @@ -- | Get the value for a named color if it exists maybeAllocColor :: Xft.XftMgr -> String -> IO (Maybe Xft.Color) -maybeAllocColor mgr c = Xft.openColorName mgr vis colormap c +maybeAllocColor mgr = Xft.openColorName mgr vis colormap where colormap = defaultColormap dpy $ defaultScreen dpy dpy = Xft.mgrDisplay mgr vis = defaultVisualOfScreen $ defaultScreenOfDisplay dpy -allocColor :: MonadIO m => Xft.XftMgr -> String -> m Xft.Color +allocColor :: (MonadIO m, MonadFail m) => Xft.XftMgr -> String -> m Xft.Color allocColor dpy c = io (maybeAllocColor dpy c) >>= maybe (fail $ "Unknown color '"++c++"'") return @@ -1182,3 +1185,65 @@ y'' <- drawElem fd y' cur foldM_ (drawElem d) y'' aft Nothing -> return () + + +data Graph = Graph { graphHistory :: [Integer] + , graphBot :: Integer + , graphTop :: Integer + } + +-- | A visual horisontal bar graph. Each data point is represented as +-- a vertical bar. Accepts the following parameters: +-- +-- [@size@] The number of data points to remember (defaults to 10) +-- +-- [@barWidth@] The width (in pixels) of a single bar (defaults to 2). +-- +-- [@bot@] The lower bound of data points as an integer. If a point +-- has this value (or below), it will be an empty bar. +-- +-- [@bot@] The upper bound of data points as an integer. If a point +-- has this value (or above), it will be a full bar. +-- +-- The following methods are supported: +-- +-- [@insert(string)@] Split @string@ into lines and add each line as +-- a data point. Each line must be an integer. +mkGraph :: Constructor SindreX11M +mkGraph r [] = do + gsize <- param "size" <|> return 10 + bwidth <- param "barWidth" <|> return 2 + bot <- param "bot" <|> return 0 + top <- param "top" <|> return 100 + visual <- visualOpts r + sindre $ return $ newWidget (Graph [] bot top) + (methods gsize) [] + recvEventI (composeI gsize bwidth) (drawI visual gsize bwidth) + where composeI gsize bwidth = return (Exact $ fi $ bwidth*gsize+2*padding, Unlimited) + methods gsize = M.fromList [ ("insert", function $ mInsert gsize) ] + mInsert :: Integer -> T.Text -> ObjectM Graph SindreX11M () + mInsert gsize vs = do + let elems = mapM (mold . StringV) $ T.lines vs + case elems of + Nothing -> fail "Not a number" + Just elems' -> forM_ elems' $ \x -> do + modify $ \s -> s { graphHistory = + genericTake gsize $ x:graphHistory s } + fullRedraw + recvEventI _ = return () + drawI visual gsize bwidth = drawing' visual $ \Rectangle{..} d _ -> do + let numpoints = fi $ max 1 (min ((rectWidth - 2*padding) `div` fi bwidth) gsize) + points <- take numpoints <$> gets graphHistory + bot <- gets graphBot + top <- gets graphTop + let dist = top - bot + hspace = fi rectHeight - 2 * padding + point (i, p) = do + let asc :: Double + asc = max 0 $ fi (p-bot) + h = round $ asc / fi dist * fi hspace + fg d fillRectangle (padding + fi rectX + i * fi bwidth) + (fi rectY + padding + hspace - h) + (fi bwidth) (fi h) + io $ mapM_ point (zip [0..] points) +mkGraph _ _ = error "Graphs do not have children" diff --git a/examples/askpass b/examples/askpass deleted file mode 100644 --- a/examples/askpass +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/bash -code=$(cat < || { exit 1; } - { print real.value; exit 0; } -real.value->changed(from, to) { visible.label = gsub(".", "*", to) } -BEGIN { focus real; label.label = prompt; } -EOF -) -exec -a askpass sindre -e "$code" "$@" diff --git a/examples/dial b/examples/dial deleted file mode 100644 --- a/examples/dial +++ /dev/null @@ -1,14 +0,0 @@ -#!/bin/bash -code=$(cat <lines(lines) { dial.value = lines; } - || || { exit 0; } -BEGIN { focus dial; } -EOF -) -exec -a dial sindre -e "$code" "$@" diff --git a/examples/dials.sindre b/examples/dials.sindre deleted file mode 100644 --- a/examples/dials.sindre +++ /dev/null @@ -1,26 +0,0 @@ -GUI { - Horizontally@"mid" { - Vertically { - Horizontally { - Vertically { left=Dial(max=12); Label(label="Left") } - Vertically { - Vertically { master=Dial(max=12); Label(label="Master") } - Vertically { pcm=Dial(max=12); Label(label="PCM") } - } - Vertically { right=Dial(max=12); Label(label="Right") } - } - Vertically { mic=Dial(max=12); Label(label="Mic") } - } - } -} -/*stdin.data(data) { master.value = data.line(0); - pcm.value = data.line(1); - mic.value = data.line(1); }*/ -BEGIN { focus master; } - { focus left } - { focus master } - { focus pcm } - { focus right } - { focus mic } -$Dial(dial)->changed(from,to) { print dial, to; } - || || { exit 0 } diff --git a/examples/dock b/examples/dock deleted file mode 100644 --- a/examples/dock +++ /dev/null @@ -1,16 +0,0 @@ -#!/bin/sh - -gui=$(cat <lines(lines) { date.label = gsub("\n", "", lines); } -logstream->lines(lines) { log.label = gsub(".*\n", "", gsub("\n$", "", lines)) } -EOF -) - -cat |\ -(while true; do date; sleep 1; done |\ -sindre --wmmode dock -e "$gui" --fd=datestream=3 --fd=logstream=4 "$@" 3<&0 0<&-) 4<&0 0<&- diff --git a/examples/fan b/examples/fan deleted file mode 100644 --- a/examples/fan +++ /dev/null @@ -1,21 +0,0 @@ -#!/bin/sh -gui() { - code=$(cat <changed(from, to) { gomanual() } -stdin->line(line) { gotlevel = 1; } -stdin->eof() { if (gotlevel) { gomanual() } else { goauto() } } -function gomanual() { print "level", dial.value; label.label = "Fan strength"; auto = 0; } -function goauto() { print "level auto"; label.label = "Automatic"; auto = 1; } - { if (auto) { gomanual() } else { goauto() } } -EOF -) - $(dirname "$0")/dial --max 7 -e "$code" -} -if ! [ -w /proc/acpi/ibm/fan ]; then - echo "Cannot write to /proc/acpi/ibm/fan - check that you have write permissions (and that this is a ThinkPad)." - exit 1 -fi -cat /proc/acpi/ibm/fan | grep '^level:.*[0-7]' | sed 's/level:[^0-9]*//' | gui \ -| while read line; do - echo $line > /proc/acpi/ibm/fan -done diff --git a/examples/filesel b/examples/filesel deleted file mode 100644 --- a/examples/filesel +++ /dev/null @@ -1,73 +0,0 @@ -#!/bin/sh - -history=${XDG_CACHE_HOME:-~/.cache}/filesel/history - -mkdir -p $(dirname historyfile) - -history() { - tac $history |\ -awk '{gsub("\"", "\"\""); print "value=\""$0"\" show=\"^fg(white)(History) ^fg()"$0"\""; fflush(); }' |\ -head -n 5 -} - -updatehistory() { - (rm "$history" && awk '$0!=SEL' "SEL=$1" > "$history") < "$history" - echo "$1" >> "$history" -} - -entry() { - awk '{gsub("\"", "\"\""); print "value=\""$0"\" show=\""substr($0, match($0, "/[^/]*/?$")+1)"\""; fflush(); }' -} - -files() { - ls -A -F "$1" | awk '{print DIR $0}' "DIR=$1" -} - -gui() { - code=$(cat <changed(from, to) { - if (to == "") { - input.value = "/"; - next; - } - list.clear(); - insertfile(); - print folder(to); -} -function complete() { - if (list.selected) { - if (match(list.selected, "^/")) { - input.value = list.selected - } else { - input.value = folder(input.value) list.selected - } - } -} -function folder(str) { return substr(str, 0, match(str, "/[^/]*$")) } -function file(str) { return substr(str, match(input.value, "[^/]*$"), RLENGTH); } -function insertfile() { - if (filename) { filename = gsub("\"", "\"\"", filename); - list.insert("value=\"" filename "\" show=\"^fg(white)" filename "\"" ) } -} -BEGIN { insertfile(); } -function filter() { list.filter(file(input.value)); } -function quit() { print; exit } -option filename(,--filename,"Default filename if a directory is selected", "filename"); -EOF - ) - dir=$(mktemp -p "${TMPDIR:-/tmp}" -d dir-XXXXXX) || exit 1 - fifo=$dir/fifo - mkfifo "$fifo" || { rmdir "$dir"; exit 1; } - sinmenu -l 10 -e "$code" -p File: -c $PWD/ "$@" < $fifo |\ -while read line; do - echo $line 1>&3 - history "$line" - files "$line" 2>/dev/null | sed 's/\*$//' | entry - done 3>&1 1>$fifo | tail -n 1 | sed '/^$/d' - rm $fifo - rmdir $dir -} - -ret=$(gui "$@") - -[ -z "$ret" ] && exit 1 || (updatehistory "$(dirname "$ret")/"; echo "$ret") diff --git a/examples/sinmenu_patches/README b/examples/sinmenu_patches/README deleted file mode 100644 --- a/examples/sinmenu_patches/README +++ /dev/null @@ -1,2 +0,0 @@ -This directory contains a number of examples on how to extend sinmenu -with usage-specific functionality. diff --git a/examples/sinmenu_patches/sinmenu_incremental b/examples/sinmenu_patches/sinmenu_incremental deleted file mode 100644 --- a/examples/sinmenu_patches/sinmenu_incremental +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/sh - -sinmenu -e 'input->changed(from,to) { if (from!=to) { print to } }' "$@" diff --git a/examples/sinmenu_patches/sinmenu_multiselect b/examples/sinmenu_patches/sinmenu_multiselect deleted file mode 100644 --- a/examples/sinmenu_patches/sinmenu_multiselect +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/sh - -actions=$(cat < { - elems=list.elements; - while (i++lines(lines) { if (clear) { list.clear(); clear = 0; } } -input->changed(from, to) { clear=1; print to; next; } -function quit() { print; exit } -EOF -) -dir=$(mktemp -p "${TMPDIR:-/tmp}" -d dir-XXXX) || exit 1 -fifo=$dir/fifo -mkfifo "$fifo" || { rmdir "$dir"; exit 1; } - -googlesuggest() { - python - "$@" <&3 - # Due to Python nonsense, we have to reencode the output. - googlesuggest "$line" | iconv -f latin1 -t utf8 & -done 3>&1 1>$fifo | tail -n 1 | sed '/^$/d' -rm $fifo -rmdir $dir diff --git a/sindre.1 b/sindre.1 deleted file mode 100644 --- a/sindre.1 +++ /dev/null @@ -1,397 +0,0 @@ -.TH SINDRE 1 sindre\-VERSION -.SH NAME -sindre \- GUI programming language -.SH SYNOPSIS -.nh -sindre -[\fB\-f \fIprogram-file\fR] -[\fB\-e \fIprogram-text\fR] -.SH DESCRIPTION -Sindre is a programming language inspired by Awk that makes it easy to -write simple graphical programs in the spirit of dzen, dmenu, xmobar, -gsmenu and the like. -.SH OPTIONS -.TP -.PD 0 -.BI \-f " program-file" -.TP -.PD -.BI \-\^\-file " program-file" -Read a program fragment from the file -.IR program-file . -Multiple -.B \-f -options may be used, and may be interleaved with -.B \-e -options. See the section on -.B Multiple Fragments -below. -.TP -.PD 0 -.BI \-e " program-text" -.TP -.PD -.BI \-\^\-expression " program-text" -Read program fragment from the argument -.IR program-text . -Multiple -.B \-e -options may be used, and may be interleaved with -.B \-f -options. See the section on -.B Code Substitution -below. -.TP -.PD 0 -.BI \-\^\-fd " NAME=FD" -Create an input stream with the given name that reads from the given -file descriptor. The file descriptor should be created by the script -invoking Sindre, for example -.ft B -sindre --fd foostream=3 3<~/.xsession-errors. -.ft R -You should never create more than one stream per file descriptor. The -standard input stream is automatically available as the -stream 'stdin'. If multiple -.B \-\^\-fd -options are given that define the same stream name, the last one will -take priority. -.TP -.PD 0 -.BI \-\^\-wmmode " normal|dock|override" " (defaults to override)" -If -.IR normal , -put the program under the management of the window manager as a normal -client. If -.IR dock , -run as a dock/panel, assuming window manager support. If -.IR override -(the default), grab control of the display and stay on top until the -program terminates. - -.SH USAGE - -.SS Lexical conventions -Identifiers start with a letter and consist of alphanumerics or -underscores. Class names start with a capital letter, while object -and variable names start with lowercase. Line-comments are supported -with // and block comments with /* ... */. Semicolons are used to -separate statements and declarations, although they are optional when -not needed to resolve ambiguity. - -.SS Overview -The Sindre language is extremely similar to Awk in syntax and -semantics, although there are subtle differences as well. A program -primarily consists of action declarations that have the form - -.TP -.IB pattern " { " statements " } " - -.P -When an event arrives, each declaration is checked in order, and those -whose pattern matches have their statements executed. Some patterns -also bind variables while executing the statements, like a function -call. The statement -.B next -can be used to immediately stop further processing of an event. -Additionally there are a few special declarations. A GUI declaration -defines a tree of possibly named widgets, and looks like - -.TP -.BI "GUI { " name "=" class "(" parameters ") { " children " } }" - -.P -where both name (including the equal sign), parameters (including the -parentheses) and children (including the braces) are optional. Each -child follows the same syntax as the body (the text between the -braces) of a GUI declaration, and should be separated by semicolons. -Widget parameters are of the form - -.P -.IB param1 " = " exp1 ", " param2 " = " exp2 ", ... , " paramN " = " expN - -.P -and are evaluated left-to-right. A parameter whose value is -considered false (see section -.BR VALUES ) -will be ignored if its value is otherwise not valid for the parameter. -Otherwise, an error will occur if the value is not what the widget -expects (for example, the string "foo" passed as the widget height). -.P -A global variable declaration looks like - -.TP -.IB name = exp - -.P -Global variables are initialised before the GUI is created, so they -can be used in widget parameters. On the other hand, they cannot -refer to widgets. If you need to perform work after the GUI has been -created, use a BEGIN declaration. -.P -Function are defined as in Awk, and recursion is supported: - -.P -.BI "function " name "(" arg1 ", " arg2 ", ..., " argN ") { " statements " }" - -.P -Arguments are lexically scoped within the function. If a function is -called with fewer arguments than given in its declaration, the -leftovers are given a false value. This is the only way to emulate -local variables. - -.SS Patterns -.TP -.B BEGIN -At program startup, after the GUI has been created. -.TP -.BI < key > -When the given key is pressed. The syntax for keys is taken from GNU -Emacs and consists of an optional set of modifiers (C- (Control), M- -(Meta/Alt), Shift, S- (Super) or H- (Hyper)) followed by a key name. -The Shift modifier is stripped from keypresses that are characters. For example, -.B -means a press of "a" while the Control key is held down, and -.B -is with a capital "A". Modifiers can be chained, so you can match -.B -if you really want to. The names for control characters, such as -BackSpace above, are taken from X11 keynames. You can use -.BR xev (1) -to figure out the names to a given key. -.TP -.IB object -> event ( name1 ", " name2 ", ..., " nameN ) -Matches when the named object sends the named event. The names will -be bound to the value payload of the event, in the same way as with a -function call. -.TP -.BI $ class ( name ")->" event ( name1 ", " name2 ", ..., " nameN ) -As above, but matches when any widget of the given class sends the -named event. -.I name -will be bound to the widget that emitted the event. -.TP -.IB pat1 " || " ... " || " patN -Matches if any of the patterns, checked left-to-right, match. - -.SS Statements -If-conditions, while-loops and for-loops are supported with the same -syntax as in Awk, except that braces are always mandatory. All -variables, except for function parameters, are global and initialised -to false at program startup. A loop can be stopped with -.B continue -or -.BR break , -with usual C semantics, and -.B return -can be used to exit early from a function. - -.SS Expressions and Values -All values, except for objects, are always passed by value in -arguments and return values. Sindre supports numbers (integers and -decimal syntax), dictionaries, strings and objects. Boolean values -are canonically represented as integers, with the number 0 being false -and any other value considered true. Strings follow the Haskell -literal syntax (which is essentially identical to that of C). Objects -can be used as event sources, as mentioned above, and have methods and -fields. A method call has the syntax object.method(args) and a field -is object.field, and can be used as an lvalue. Dictionaries differ -significantly from those in Awk, as they have no special syntactical -treatment. An empty dictionary is written as -.B [] -and elements can be added/changed by using the usual Awk-like syntax -.BR foo["bar"]=4 , -although the variable must already contain a dictionary or you will -get an error (so use -.B foo=[] -to initialise). Keys and values can have any type. -Multidimensional dictionaries are only supported by making the values -dictionaries themselves, and has no special syntax, and arrays are -merely dictionaries with integral keys. - -.SS Multiple Fragments -When multiple -.B \-f -and -.B \-e -options are used, Sindre conceptually concatenates the given program -text fragments in the order of the options. There are two differences -from plain concatenation, however: - -.TP -.B Duplicate definitions -A program fragment is normally not allowed to define two global -variables or functions with the same name, nor to contain two GUI -declarations. When the above options are used, redefinitions of previous -definitions appearing in later fragments take precedence. - -.TP -.B Event handling priority -Event handlers are run from top to bottom in terms of the program -text, but event handlers in later fragments are run first. Thus, - -.ft B - sindre -e 'obj->ev() { print "foo" } - obj->ev() { print "bar" }' - -e 'obj->ev() { print "baz" }' -.ft R - -will print "baz foo bar" whenever the event -.B obj->ev() -happens. BEGIN declarations are similarly executed in reverse order. - -.ft B - sindre -e 'BEGIN { print "I go last" }' - -e 'BEGIN { print "I go first" }' -.ft R -.SS Special Variables -.TP "\w'ENVIRON'u+1n" -.B RSTART -After regular expression matching, this variable will be set to the -index (1-based) of the match. -.TP -.B RLENGTH -The length of the most recent regular expression match. -.TP -.B ENVIRON -A dictionary containing the environment variables of the Sindre -process. Note that changing this dictionary currently has no effect -on the environment. -.TP -.B EXITVAL -Whenever an external program has been run, this variable will contain -its exit value. - -.SS Numeric functions -.TP "\w'atan2(x, y)'u+1n" -.BI abs( n ) -The numeric value of -.IR n . -.TP -.BI atan2( x , " y" ) -Arctangent of -.I x/y -in radians. -.TP -.BI cos( x ) -Cosine of -.IR x , -in radians. -.TP -.BI sin( x ) -Sine of -.IR x , -in radians. -.TP -.BI exp( x ) -Natural exponent of -.IR x . -.TP -.BI log( x ) -Natural logarithm of -.IR x . -.TP -.BI int( x ) -.I x -truncated to an integer. -.TP -.TP -.BI sqrt( x ) -The square root of -.IR x . - -.SS String Functions -.PP -Note that indexes are 1-based. -.PP -.TP "\w'substr(s, m, n)'u+1n" -.BI length( s ) -Returns the number of characters in -.I s -.TP -.BI substr( s , " m" , " n" ) -Return -.I n -characters of -.IR s , -starting from character number -.IR m . -If either -.IR n or m -is out of bounds, the resulting string may be less than -.I n -characters. -.TP -.BI index( s , " t" ) -Return the index at which -.I t -is found in -.IR s , -or 0 if -.I t -is not present. -.TP -.BI match( s , " r" ) -Match the regular expression -.I r -against -.IR t , -returning the index of the first match, as well as setting -.B RMATCH -and -.BR RLENGTH . -.TP -.BI gsub( r , " t" , " s" ) -For each match of the regular expression -.I r -in -.IR s , -return a new string where each of those matches is replaced with -.IR t . -.TP -.BI sub( r , " t" , " S" ) -Like -.IR sub , -but only the first match is replaced. -.TP -.BI tolower( s ) -Return an all-lowercase version of -.IR s . -.TP -.BI toupper( s ) -Return an all-uppercase version of -.IR s . - -.SS System Functions -.TP "\w'osystem(s)'u+1n" -.BI osystem( s ) -Run -.I s -as a shell command and return its output. -.TP -.BI system( s ) -Run -.I s -as a shell command and return its exit value. - -.SH EXIT STATUS -Sindre returns a -.B 0 -exit status on success, and -.B 1 -if there was an internal problem. - -.SH EXAMPLES -See the examples/ subdirectory of the Sindre source tree. - -.SH SEE ALSO -.BR dmenu (1), -.BR awk (1), -.BR sinmenu (1) - -.SH BUGS -The syntax and semantics for local variables are inherited from Awk, -and are rather ugly. It is possible to write programs that have no -way of exiting, short of killing the process manually. Actions are -executed atomically and synchronously, so an infinite loop can freeze -the program, requiring the user to kill it manually. diff --git a/sindre.cabal b/sindre.cabal --- a/sindre.cabal +++ b/sindre.cabal @@ -1,17 +1,16 @@ +cabal-version: 2.4 name: sindre -version: 0.4 +version: 0.6 homepage: http://sigkill.dk/programs/sindre synopsis: A programming language for simple GUIs description: Sindre is a language inspired by Awk, meant for creating very simple graphical user interfaces. category: GUI -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Troels Henriksen maintainer: athas@sigkill.dk -cabal-version: >= 1.10 -build-type: Custom source-repository head type: git @@ -31,8 +30,10 @@ Sindre.KeyVal Sindre.Main Graphics.X11.Xft + Paths_sindre + autogen-modules: Paths_sindre - build-depends: X11>=1.5.0.0 && < 1.6, X11-xshape>=0.1.1, X11-rm>=0.2, + build-depends: X11, X11-xshape>=0.1.1, X11-rm>=0.2, mtl, base >= 4.3 && < 5, containers, parsec>=3.1, array>=0.3, x11-xim>=0.0.6, setlocale, regex-pcre, process, text, bytestring, unix, attoparsec>=0.10, @@ -40,8 +41,8 @@ ghc-options: -Wall - ghc-prof-options: -prof -auto-all -rtsopts - pkgconfig-depends: xft + ghc-prof-options: -rtsopts + pkgconfig-depends: xft, xext default-language: Haskell2010 library @@ -59,11 +60,13 @@ Graphics.X11.Xft other-modules: Paths_sindre + autogen-modules: Paths_sindre - build-depends: X11>=1.5.0.0 && < 1.6, X11-xshape>=0.1.1, X11-rm, + + build-depends: X11>=1.5.0.0, X11-xshape>=0.1.1, X11-rm, mtl, base >= 4.3 && < 5, containers, parsec>=3.1, array>=0.3, x11-xim>=0.0.5, setlocale, regex-pcre, process, text, bytestring, unix, attoparsec>=0.10.1.0, permute, utf8-string>=0.3 - pkgconfig-depends: xft + pkgconfig-depends: xft, xext default-language: Haskell2010 diff --git a/sinmenu b/sinmenu deleted file mode 100644 --- a/sinmenu +++ /dev/null @@ -1,60 +0,0 @@ -#!/bin/sh -gui=$(cat <lines(lines) { list.insert(lines) } -BEGIN { focus input } - || || { quit() } - || || { list.prev() } - || || { list.next() } - || { complete(); select(); } - || { select(); } - || { complete() } - { input.value = sub("\n.*", "", osystem("sselp")) } - { list.last() } - { list.first() } -input.value->changed(from, to) { filter() } -EOF -) -sindre -e "$gui" -e "$code" "$@" diff --git a/sinmenu.1 b/sinmenu.1 deleted file mode 100644 --- a/sinmenu.1 +++ /dev/null @@ -1,75 +0,0 @@ -.TH SINMENU 1 sinmenu\-VERSION -.SH NAME -sinmenu \- slower dmenu that uses more memory -.SH SYNOPSIS -.B sinmenu -[\fB\-b\fR] -[\fB\-i\fR] -[\fB\-l\fI lines\fR] -[\fB\-p\fI prompt\fR] -[\fISindre options...\fR] -.SH DESCRIPTION -.B sinmenu -is a dynamic menu for X, a clone of -.BR dmenu (1) -written in Sindre. It manages large numbers of user\-defined menu -items efficiently. -.P -sinmenu reads a list of newline\-separated items from standard input -and creates a menu. When the user selects an item or enters any text -and presses Return, their choice is printed to standard output and -sinmenu terminates. -.P -.SH OPTIONS -.TP -.B \-b -Appear at bottom of screen. -.TP -.B \-i -Match menu items case insensitively. -.TP -.BI \-l " lines" -List items vertically, with the given number of lines. -.TP -.BI \-p " prompt" -The prompt to be displayed to the left of the input field. -.TP -.BI \-\-font " font" -The font or font set used. -.TP -.BI \-\-nb " color" -The normal background color. -.IR #RGB , -.IR #RRGGBB , -and X color names are supported. -.TP -.BI \-\-nf " color" -Normal foreground color. -.TP -.BI \-\-sb " color" -Background color of prompt and selected element. -.TP -.BI \-\-sf " color" -Foreground color of prompt and selected element. -.SH USAGE -sinmenu is controlled by the keyboard via an eclectic mix of Emacs, -Unix and dmenu conventions. -.TP -.B Tab (C\-i) -Copy the selected item to the input field. -.TP -.B Return (C\-j) -Confirm selection. Prints the selected item to stdout and exits, returning -success. -.TP -.B Shift\-Return (C\-J) -Confirm input. Prints the input text to stdout and exits, returning success. -.TP -.B Escape (C\-c) or C\-g -Exit without selecting an item, returning failure. -.TP -.B C\-y -Paste the current X solution to the input field, using -.BR sselp (1). -.SH SEE ALSO -.BR sindre "(1), " dmenu "(1), " sselp (1) diff --git a/tests/Properties.hs b/tests/Properties.hs deleted file mode 100644 --- a/tests/Properties.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -module Properties where - -import Sindre.Sindre - -import Test.QuickCheck -import Text.Printf - -import Control.Applicative -import Control.Monad -import Data.Monoid - -main :: IO () -main = mapM_ (\(s,a) -> putStr (s++": ") >> a) tests - -instance Arbitrary Rectangle where - arbitrary = pure Rectangle - <*> choose (0,1000) <*> choose (0,1000) - <*> choose (0,1000) <*> choose (0,1000) - --- Transposing a rectangle twice is the same as identity. -prop_transposetranspose :: Rectangle -> Bool -prop_transposetranspose r = - (rectTranspose . rectTranspose) r == r - -prop_rectangle_mempty :: Rectangle -> Bool -prop_rectangle_mempty r = - r `mappend` mempty == r && mempty `mappend` r == r - -prop_rectangle_mappend_associative :: Rectangle -> Rectangle -> Rectangle -> Bool -prop_rectangle_mappend_associative r1 r2 r3 = - r1 `mappend` (r2 `mappend` r3) == (r1 `mappend` r2) `mappend` r3 - -prop_rectangle_mappend_idempotent :: Rectangle -> Rectangle -> Bool -prop_rectangle_mappend_idempotent r1 r2 = - r1 `mappend` r2 `mappend` r2 == r1 `mappend` r2 && - r1 `mappend` r2 `mappend` r1 == r1 `mappend` r2 && - r2 `mappend` r1 `mappend` r1 == r1 `mappend` r2 && - r2 `mappend` r1 `mappend` r2 == r1 `mappend` r2 - -instance Arbitrary DimNeed where - arbitrary = oneof [ liftM Min (choose (0,100)) - , liftM Max (choose (0,100)) - , return Unlimited - , liftM Exact (choose (0,100)) ] - -newtype BigEnoughDim = BigEnoughDim ([DimNeed], Integer) - deriving (Show) - --- The dimension is guaranteed to be able to satisfy the requirements. -instance Arbitrary BigEnoughDim where - arbitrary = do needs <- arbitrary - let (x1,x2) = foldl (\(x1,y1) (x2,y2) -> (x1+x2,y1+y2)) (0,0) - $ map range needs - dim <- choose (x1, x2) - return $ BigEnoughDim (needs, dim) - where range (Min x) = (x,2*x) - range (Max x) = (0,x) - range (Exact x) = (x,x) - range Unlimited = (0,100) - -satisfied :: DimNeed -> Integer -> Bool -satisfied (Min x) y = x <= y -satisfied (Max x) y = x >= y -satisfied (Exact x) y = x == y -satisfied Unlimited _ = True - -prop_hsplit_satisfies :: BigEnoughDim -> Bool -prop_hsplit_satisfies (BigEnoughDim (needs, dim)) = - length needs == length rs && - all (uncurry satisfied) (zip needs $ map rectHeight rs) - where rs = splitHoriz (Rectangle 0 0 10 dim) needs - -prop_hsplit_union :: [DimNeed] -> Rectangle -> Bool -prop_hsplit_union needs r = - length needs == length rs && (null needs || mconcat rs == r) - where rs = splitHoriz r needs - -prop_vsplit_satisfies :: BigEnoughDim -> Bool -prop_vsplit_satisfies (BigEnoughDim (needs, dim)) = - length needs == length rs && - all (uncurry satisfied) (zip needs $ map rectWidth rs) - where rs = splitVert (Rectangle 0 0 dim 10) needs - -prop_vsplit_union :: [DimNeed] -> Rectangle -> Bool -prop_vsplit_union needs r = - length needs == length rs && (null needs || mconcat rs == r) - where rs = splitVert r needs - -prop_constrains_idempotent :: SpaceNeed -> Constraints -> Bool -prop_constrains_idempotent s c = - constrainNeed (constrainNeed s c) c == constrainNeed s c - -prop_fitRect_idempotent :: Rectangle -> SpaceNeed -> Bool -prop_fitRect_idempotent r s = - fitRect (fitRect r s) s == fitRect r s - -prop_fitRect_subrect :: Rectangle -> SpaceNeed -> Bool -prop_fitRect_subrect r s = - fitRect r s `mappend` r == r - -prop_fitRect_fits :: Rectangle -> SpaceNeed -> Bool -prop_fitRect_fits r s = check rectWidth (fst s) && check rectHeight (snd s) - where check f (Exact x) | x <= f r = f (fitRect r s) == x - | otherwise = f (fitRect r s) == f r - check f (Min x) | x <= f r = f (fitRect r s) >= x - | otherwise = f (fitRect r s) == f r - check f (Max x) = f (fitRect r s) <= x - check _ Unlimited = True - -instance Arbitrary Align where - arbitrary = elements [AlignCenter, AlignNeg, AlignPos] - -prop_align_fits :: Align -> Property -prop_align_fits a = do - minp <- arbitrary `suchThat` (>=(0::Integer)) - d <- arbitrary `suchThat` (>=0) - maxp <- arbitrary `suchThat` (>=d+minp) - let d' = align a minp d maxp - d' >= minp .&. d' <= maxp .&. d'+d <= maxp .&. - case a of AlignCenter -> abs ((d'-minp)-(maxp-d'-d)) <= 1 - AlignNeg -> d'==minp - AlignPos -> d'==maxp-d - -tests :: [(String, IO ())] -tests = [ ( "Transposing twice is identity" - , quickCheck prop_transposetranspose) - , ( "Rectangle mempty is identity" - , quickCheck prop_rectangle_mempty) - , ( "Rectangle mappend is associative" - , quickCheck prop_rectangle_mappend_associative) - , ( "Rectangle mappend is idempotent" - , quickCheck prop_rectangle_mappend_idempotent) - , ( "Horizontal split fulfills constraints" - , quickCheck prop_hsplit_satisfies ) - , ( "Union is inverse of horizontal split" - , quickCheck prop_hsplit_union ) - , ( "Vertical split fulfills constraints" - , quickCheck prop_vsplit_satisfies ) - , ( "Union is inverse of vertical split" - , quickCheck prop_vsplit_union ) - , ( "Constraining is idempotent" - , quickCheck prop_constrains_idempotent ) - , ( "Rectangle fitting is idempotent" - , quickCheck prop_fitRect_idempotent ) - , ( "Fitted rectangle is a subrectangle" - , quickCheck prop_fitRect_subrect ) - , ( "Rectangle fitting fits" - , quickCheck prop_fitRect_fits ) - , ( "Aligning fits and cannot be improved" - , quickCheck prop_align_fits) - ]