{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Sindre.Sindre
-- License     :  MIT-style (see LICENSE)
--
-- Stability   :  provisional
-- Portability :  portable
--
-- General definitions for the Sindre programming language.  The
-- documentation for this module does not include a description of the
-- language semantics.
--
-----------------------------------------------------------------------------
module Sindre.Sindre ( 
  -- * Screen layout
  Rectangle(..),
  DimNeed(..),
  SpaceNeed,
  SpaceUse,
  Constraints,
  Align(..),
  -- ** Layouting functions
  constrainNeed,
  fitRect,
  splitHoriz,
  splitVert,
  rectTranspose,
  align,
  adjustRect,
  -- * Keyboard Input
  KeyModifier(..),
  Key(..),
  Chord,
  -- * Input positions
  P(..),
  at,
  SourcePos,
  nowhere,
  position,
  -- * Abstract syntax tree
  Identifier,
  Stmt(..),
  Expr(..),
  ObjectNum,
  ObjectRef,
  WidgetRef,
  -- ** Value representation
  Value(..),
  string,
  true,
  truth,
  falsity,
  -- ** Program structure
  Event(..),
  EventSource(..),
  SourcePat(..),
  Pattern(..),
  Action(..),
  Function(..),
  GUI(..),
  Program(..),
  SindreOption,
  Arguments
                     )
    where

import Sindre.Util

import System.Console.GetOpt
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T

-- | A rectangle represented as its upper-left corner, width and
-- height.  You should never create rectangles with negative
-- dimensions, and the functions in this module make no guarantee to
-- their behaviour if you do.
data Rectangle = Rectangle {
      Rectangle -> Integer
rectX      :: Integer
    , Rectangle -> Integer
rectY      :: Integer
    , Rectangle -> Integer
rectWidth  :: Integer
    , Rectangle -> Integer
rectHeight :: Integer
    } deriving (Int -> Rectangle -> ShowS
[Rectangle] -> ShowS
Rectangle -> String
(Int -> Rectangle -> ShowS)
-> (Rectangle -> String)
-> ([Rectangle] -> ShowS)
-> Show Rectangle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rectangle] -> ShowS
$cshowList :: [Rectangle] -> ShowS
show :: Rectangle -> String
$cshow :: Rectangle -> String
showsPrec :: Int -> Rectangle -> ShowS
$cshowsPrec :: Int -> Rectangle -> ShowS
Show, Rectangle -> Rectangle -> Bool
(Rectangle -> Rectangle -> Bool)
-> (Rectangle -> Rectangle -> Bool) -> Eq Rectangle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rectangle -> Rectangle -> Bool
$c/= :: Rectangle -> Rectangle -> Bool
== :: Rectangle -> Rectangle -> Bool
$c== :: Rectangle -> Rectangle -> Bool
Eq)

instance Monoid Rectangle where
  mempty :: Rectangle
mempty = Integer -> Integer -> Integer -> Integer -> Rectangle
Rectangle Integer
0 Integer
0 (-Integer
1) (-Integer
1)

instance Semigroup Rectangle where
  r1 :: Rectangle
r1@(Rectangle Integer
x1 Integer
y1 Integer
w1 Integer
h1) <> :: Rectangle -> Rectangle -> Rectangle
<> r2 :: Rectangle
r2@(Rectangle Integer
x2 Integer
y2 Integer
w2 Integer
h2)
    | Rectangle
r1 Rectangle -> Rectangle -> Bool
forall a. Eq a => a -> a -> Bool
== Rectangle
forall a. Monoid a => a
mempty = Rectangle
r2
    | Rectangle
r2 Rectangle -> Rectangle -> Bool
forall a. Eq a => a -> a -> Bool
== Rectangle
forall a. Monoid a => a
mempty = Rectangle
r1
    | Bool
otherwise = Integer -> Integer -> Integer -> Integer -> Rectangle
Rectangle Integer
x' Integer
y' (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (Integer
x1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
w1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
x') (Integer
x2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
w2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
x'))
                                  (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (Integer
y1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
h1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
y') (Integer
y2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
h2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
y'))
    where (Integer
x', Integer
y') = (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
x1 Integer
x2, Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
y1 Integer
y2)

-- | Flip the x and y coordinates and width and height of a rectangle,
-- in a sense rotating it ninety degrees.  Note that @rectTranspose
-- . rectTranspose = id@.
rectTranspose :: Rectangle -> Rectangle
rectTranspose :: Rectangle -> Rectangle
rectTranspose (Rectangle Integer
x Integer
y Integer
w Integer
h) = Integer -> Integer -> Integer -> Integer -> Rectangle
Rectangle Integer
y Integer
x Integer
h Integer
w

zipper :: (([a], a, [a]) -> ([a], a, [a])) -> [a] -> [a]
zipper :: (([a], a, [a]) -> ([a], a, [a])) -> [a] -> [a]
zipper ([a], a, [a]) -> ([a], a, [a])
f = [a] -> [a] -> [a]
zipper' []
    where zipper' :: [a] -> [a] -> [a]
zipper' [a]
a (a
x:[a]
xs) = let ([a]
a', a
x', [a]
xs') = ([a], a, [a]) -> ([a], a, [a])
f ([a]
a, a
x, [a]
xs)
                             in [a] -> [a] -> [a]
zipper' (a
x'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a') [a]
xs'
          zipper' [a]
a [] = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
a

-- | @splitHoriz rect dims@ splits @rect@ horizontally into a number
-- of non-overlapping equal-width rectangles stacked on top of each
-- other.  @dims@ is a list of height requirements that the function
-- will attempt to fulfill as best it is able.  The union of the list
-- of returned rectangles will always be equal to @rect@.  No
-- rectangle will ever have negative dimensions.
splitHoriz :: Rectangle -> [DimNeed] -> [Rectangle]
splitHoriz :: Rectangle -> [DimNeed] -> [Rectangle]
splitHoriz (Rectangle Integer
x1 Integer
y1 Integer
w Integer
h) [DimNeed]
parts =
    (Integer, [Rectangle]) -> [Rectangle]
forall a b. (a, b) -> b
snd ((Integer, [Rectangle]) -> [Rectangle])
-> (Integer, [Rectangle]) -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> (Integer, Rectangle))
-> Integer -> [Integer] -> (Integer, [Rectangle])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Integer -> Integer -> (Integer, Rectangle)
mkRect Integer
y1 ([Integer] -> (Integer, [Rectangle]))
-> [Integer] -> (Integer, [Rectangle])
forall a b. (a -> b) -> a -> b
$ ((Integer, DimNeed) -> Integer)
-> [(Integer, DimNeed)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, DimNeed) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, DimNeed)] -> [Integer])
-> [(Integer, DimNeed)] -> [Integer]
forall a b. (a -> b) -> a -> b
$
        (([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
 -> ([(Integer, DimNeed)], (Integer, DimNeed),
     [(Integer, DimNeed)]))
-> [(Integer, DimNeed)] -> [(Integer, DimNeed)]
forall a. (([a], a, [a]) -> ([a], a, [a])) -> [a] -> [a]
zipper ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
-> ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
adjust ([(Integer, DimNeed)] -> [(Integer, DimNeed)])
-> [(Integer, DimNeed)] -> [(Integer, DimNeed)]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [DimNeed] -> [(Integer, DimNeed)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Integer -> Integer -> [Integer]
forall a. Integral a => a -> a -> [a]
divide Integer
h Integer
nparts) [DimNeed]
parts
    where nparts :: Integer
nparts = [DimNeed] -> Integer
forall i a. Num i => [a] -> i
genericLength [DimNeed]
parts
          mkRect :: Integer -> Integer -> (Integer, Rectangle)
mkRect Integer
y Integer
h' = (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
h', Integer -> Integer -> Integer -> Integer -> Rectangle
Rectangle Integer
x1 Integer
y Integer
w Integer
h')
          grab :: Integer -> (Integer, DimNeed) -> ((Integer, DimNeed), Integer)
grab Integer
d (Integer
v, Min Integer
mv) | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     = let d' :: Integer
d' = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
d (Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
mv)
                                           in ((Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d', Integer -> DimNeed
Min Integer
mv), Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d')
                             | Bool
otherwise = ((Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d, Integer -> DimNeed
Min Integer
mv), Integer
0)
          grab Integer
d (Integer
v, Max Integer
mv) | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     = let d' :: Integer
d' = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
v Integer
d
                                           in ((Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d', Integer -> DimNeed
Max Integer
mv), Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d')
                             | Bool
otherwise = let d' :: Integer
d' = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
mv) Integer
d
                                           in ((Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d', Integer -> DimNeed
Max Integer
mv), Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d')
          grab Integer
d (Integer
v, DimNeed
Unlimited) = let v' :: Integer
v' = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
d
                                  in ((Integer
v', DimNeed
Unlimited), Integer
v'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
d)
          grab Integer
d (Integer
v, Exact Integer
ev) | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
ev = let d' :: Integer
d' = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
v (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
d (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
ev
                                          in ((Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d', Integer -> DimNeed
Exact Integer
ev), Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d')
                               | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
ev = let d' :: Integer
d' = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
v (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
d (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
evInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
v
                                          in ((Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d', Integer -> DimNeed
Exact Integer
ev), Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d')
                               | Bool
otherwise = ((Integer
v, Integer -> DimNeed
Exact Integer
ev), Integer
d)
          maybeGrab :: [Integer]
-> [((Integer, DimNeed), Bool)]
-> [(((Integer, DimNeed), Bool), Integer)]
maybeGrab (Integer
d:[Integer]
ds) (((Integer, DimNeed)
x, Bool
True):[((Integer, DimNeed), Bool)]
xs) =
            (case Integer -> (Integer, DimNeed) -> ((Integer, DimNeed), Integer)
grab Integer
d (Integer, DimNeed)
x of ((Integer, DimNeed)
x',Integer
0)  -> (((Integer, DimNeed)
x',Bool
True),Integer
0)
                              ((Integer, DimNeed)
x',Integer
d') -> (((Integer, DimNeed)
x',Bool
False),Integer
d')) (((Integer, DimNeed), Bool), Integer)
-> [(((Integer, DimNeed), Bool), Integer)]
-> [(((Integer, DimNeed), Bool), Integer)]
forall a. a -> [a] -> [a]
: [Integer]
-> [((Integer, DimNeed), Bool)]
-> [(((Integer, DimNeed), Bool), Integer)]
maybeGrab [Integer]
ds [((Integer, DimNeed), Bool)]
xs
          maybeGrab [Integer]
ds (((Integer, DimNeed)
x, Bool
False):[((Integer, DimNeed), Bool)]
xs)    = (((Integer, DimNeed)
x,Bool
False),Integer
0) (((Integer, DimNeed), Bool), Integer)
-> [(((Integer, DimNeed), Bool), Integer)]
-> [(((Integer, DimNeed), Bool), Integer)]
forall a. a -> [a] -> [a]
: [Integer]
-> [((Integer, DimNeed), Bool)]
-> [(((Integer, DimNeed), Bool), Integer)]
maybeGrab [Integer]
ds [((Integer, DimNeed), Bool)]
xs
          maybeGrab [Integer]
_  [((Integer, DimNeed), Bool)]
_                  = []
          obtain :: Integer
-> [((Integer, DimNeed), Bool)]
-> [((Integer, DimNeed), Bool)]
-> ([((Integer, DimNeed), Bool)], [((Integer, DimNeed), Bool)],
    Integer)
obtain Integer
v [((Integer, DimNeed), Bool)]
bef [((Integer, DimNeed), Bool)]
aft =
            case ((((Integer, DimNeed), Bool) -> Bool)
-> [((Integer, DimNeed), Bool)] -> [((Integer, DimNeed), Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer, DimNeed), Bool) -> Bool
forall a b. (a, b) -> b
snd [((Integer, DimNeed), Bool)]
bef, (((Integer, DimNeed), Bool) -> Bool)
-> [((Integer, DimNeed), Bool)] -> [((Integer, DimNeed), Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer, DimNeed), Bool) -> Bool
forall a b. (a, b) -> b
snd [((Integer, DimNeed), Bool)]
aft) of
              ([],[]) -> ([((Integer, DimNeed), Bool)]
bef,[((Integer, DimNeed), Bool)]
aft,Integer
v)
              ([((Integer, DimNeed), Bool)]
bef',[((Integer, DimNeed), Bool)]
aft') ->
                let q :: [Integer]
q = Integer -> Integer -> [Integer]
forall a. Integral a => a -> a -> [a]
divide Integer
v (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$ [((Integer, DimNeed), Bool)] -> Integer
forall i a. Num i => [a] -> i
genericLength ([((Integer, DimNeed), Bool)] -> Integer)
-> [((Integer, DimNeed), Bool)] -> Integer
forall a b. (a -> b) -> a -> b
$ [((Integer, DimNeed), Bool)]
bef'[((Integer, DimNeed), Bool)]
-> [((Integer, DimNeed), Bool)] -> [((Integer, DimNeed), Bool)]
forall a. [a] -> [a] -> [a]
++[((Integer, DimNeed), Bool)]
aft'
                    n :: Int
n = [((Integer, DimNeed), Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((Integer, DimNeed), Bool)]
bef'
                    ([((Integer, DimNeed), Bool)]
bef'',[Integer]
x) = [(((Integer, DimNeed), Bool), Integer)]
-> ([((Integer, DimNeed), Bool)], [Integer])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(((Integer, DimNeed), Bool), Integer)]
 -> ([((Integer, DimNeed), Bool)], [Integer]))
-> [(((Integer, DimNeed), Bool), Integer)]
-> ([((Integer, DimNeed), Bool)], [Integer])
forall a b. (a -> b) -> a -> b
$ [Integer]
-> [((Integer, DimNeed), Bool)]
-> [(((Integer, DimNeed), Bool), Integer)]
maybeGrab [Integer]
q [((Integer, DimNeed), Bool)]
bef
                    ([((Integer, DimNeed), Bool)]
aft'',[Integer]
y) = [(((Integer, DimNeed), Bool), Integer)]
-> ([((Integer, DimNeed), Bool)], [Integer])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(((Integer, DimNeed), Bool), Integer)]
 -> ([((Integer, DimNeed), Bool)], [Integer]))
-> [(((Integer, DimNeed), Bool), Integer)]
-> ([((Integer, DimNeed), Bool)], [Integer])
forall a b. (a -> b) -> a -> b
$ [Integer]
-> [((Integer, DimNeed), Bool)]
-> [(((Integer, DimNeed), Bool), Integer)]
maybeGrab (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
n [Integer]
q) [((Integer, DimNeed), Bool)]
aft
                    r :: Integer
r = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
y
                in if Integer
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 then Integer
-> [((Integer, DimNeed), Bool)]
-> [((Integer, DimNeed), Bool)]
-> ([((Integer, DimNeed), Bool)], [((Integer, DimNeed), Bool)],
    Integer)
obtain Integer
r [((Integer, DimNeed), Bool)]
bef'' [((Integer, DimNeed), Bool)]
aft'' else ([((Integer, DimNeed), Bool)]
bef'',[((Integer, DimNeed), Bool)]
aft'', Integer
r)
          adjust :: ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
-> ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
adjust ([(Integer, DimNeed)]
bef, (Integer
v, Min Integer
mv), [(Integer, DimNeed)]
aft)
            | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mv = (Integer -> DimNeed)
-> [(Integer, DimNeed)]
-> Integer
-> Integer
-> [(Integer, DimNeed)]
-> ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
forall b.
(Integer -> b)
-> [(Integer, DimNeed)]
-> Integer
-> Integer
-> [(Integer, DimNeed)]
-> ([(Integer, DimNeed)], (Integer, b), [(Integer, DimNeed)])
adjust' Integer -> DimNeed
Min [(Integer, DimNeed)]
bef Integer
v Integer
mv [(Integer, DimNeed)]
aft
          adjust ([(Integer, DimNeed)]
bef, (Integer
v, Max Integer
mv), [(Integer, DimNeed)]
aft)
            | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
mv = (Integer -> DimNeed)
-> [(Integer, DimNeed)]
-> Integer
-> Integer
-> [(Integer, DimNeed)]
-> ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
forall b.
(Integer -> b)
-> [(Integer, DimNeed)]
-> Integer
-> Integer
-> [(Integer, DimNeed)]
-> ([(Integer, DimNeed)], (Integer, b), [(Integer, DimNeed)])
adjust' Integer -> DimNeed
Max [(Integer, DimNeed)]
bef Integer
v Integer
mv [(Integer, DimNeed)]
aft
          adjust ([(Integer, DimNeed)]
bef, (Integer
v, Exact Integer
ev), [(Integer, DimNeed)]
aft)
            | Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
ev = (Integer -> DimNeed)
-> [(Integer, DimNeed)]
-> Integer
-> Integer
-> [(Integer, DimNeed)]
-> ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
forall b.
(Integer -> b)
-> [(Integer, DimNeed)]
-> Integer
-> Integer
-> [(Integer, DimNeed)]
-> ([(Integer, DimNeed)], (Integer, b), [(Integer, DimNeed)])
adjust' Integer -> DimNeed
Exact [(Integer, DimNeed)]
bef Integer
v Integer
ev [(Integer, DimNeed)]
aft
          adjust ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
x = ([(Integer, DimNeed)], (Integer, DimNeed), [(Integer, DimNeed)])
x
          adjust' :: (Integer -> b)
-> [(Integer, DimNeed)]
-> Integer
-> Integer
-> [(Integer, DimNeed)]
-> ([(Integer, DimNeed)], (Integer, b), [(Integer, DimNeed)])
adjust' Integer -> b
f [(Integer, DimNeed)]
bef Integer
v Integer
mv [(Integer, DimNeed)]
aft =
            let ([((Integer, DimNeed), Bool)]
bef', [((Integer, DimNeed), Bool)]
aft', Integer
d) =
                  Integer
-> [((Integer, DimNeed), Bool)]
-> [((Integer, DimNeed), Bool)]
-> ([((Integer, DimNeed), Bool)], [((Integer, DimNeed), Bool)],
    Integer)
obtain (Integer
mvInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
v) (((Integer, DimNeed) -> ((Integer, DimNeed), Bool))
-> [(Integer, DimNeed)] -> [((Integer, DimNeed), Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True) [(Integer, DimNeed)]
bef) (((Integer, DimNeed) -> ((Integer, DimNeed), Bool))
-> [(Integer, DimNeed)] -> [((Integer, DimNeed), Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True) [(Integer, DimNeed)]
aft)
            in ((((Integer, DimNeed), Bool) -> (Integer, DimNeed))
-> [((Integer, DimNeed), Bool)] -> [(Integer, DimNeed)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer, DimNeed), Bool) -> (Integer, DimNeed)
forall a b. (a, b) -> a
fst [((Integer, DimNeed), Bool)]
bef', (Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+(Integer
mvInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
v)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d, Integer -> b
f Integer
mv), (((Integer, DimNeed), Bool) -> (Integer, DimNeed))
-> [((Integer, DimNeed), Bool)] -> [(Integer, DimNeed)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer, DimNeed), Bool) -> (Integer, DimNeed)
forall a b. (a, b) -> a
fst [((Integer, DimNeed), Bool)]
aft')

-- | As @splitHoriz@, but splits vertically instead of horizontally,
-- so the rectangles will be next to each other.
splitVert :: Rectangle -> [DimNeed] -> [Rectangle]
splitVert :: Rectangle -> [DimNeed] -> [Rectangle]
splitVert Rectangle
r = (Rectangle -> Rectangle) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Rectangle
rectTranspose ([Rectangle] -> [Rectangle])
-> ([DimNeed] -> [Rectangle]) -> [DimNeed] -> [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> [DimNeed] -> [Rectangle]
splitHoriz (Rectangle -> Rectangle
rectTranspose Rectangle
r)

-- | A size constraint in one dimension.
data DimNeed = Min Integer -- ^ At minimum this many pixels.
             | Max Integer -- ^ At most this many pixels.
             | Unlimited -- ^ As many or as few pixels as necessary.
             | Exact Integer -- ^ Exactly this many pixels.
         deriving (DimNeed -> DimNeed -> Bool
(DimNeed -> DimNeed -> Bool)
-> (DimNeed -> DimNeed -> Bool) -> Eq DimNeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DimNeed -> DimNeed -> Bool
$c/= :: DimNeed -> DimNeed -> Bool
== :: DimNeed -> DimNeed -> Bool
$c== :: DimNeed -> DimNeed -> Bool
Eq, Int -> DimNeed -> ShowS
[DimNeed] -> ShowS
DimNeed -> String
(Int -> DimNeed -> ShowS)
-> (DimNeed -> String) -> ([DimNeed] -> ShowS) -> Show DimNeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DimNeed] -> ShowS
$cshowList :: [DimNeed] -> ShowS
show :: DimNeed -> String
$cshow :: DimNeed -> String
showsPrec :: Int -> DimNeed -> ShowS
$cshowsPrec :: Int -> DimNeed -> ShowS
Show, Eq DimNeed
Eq DimNeed
-> (DimNeed -> DimNeed -> Ordering)
-> (DimNeed -> DimNeed -> Bool)
-> (DimNeed -> DimNeed -> Bool)
-> (DimNeed -> DimNeed -> Bool)
-> (DimNeed -> DimNeed -> Bool)
-> (DimNeed -> DimNeed -> DimNeed)
-> (DimNeed -> DimNeed -> DimNeed)
-> Ord DimNeed
DimNeed -> DimNeed -> Bool
DimNeed -> DimNeed -> Ordering
DimNeed -> DimNeed -> DimNeed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DimNeed -> DimNeed -> DimNeed
$cmin :: DimNeed -> DimNeed -> DimNeed
max :: DimNeed -> DimNeed -> DimNeed
$cmax :: DimNeed -> DimNeed -> DimNeed
>= :: DimNeed -> DimNeed -> Bool
$c>= :: DimNeed -> DimNeed -> Bool
> :: DimNeed -> DimNeed -> Bool
$c> :: DimNeed -> DimNeed -> Bool
<= :: DimNeed -> DimNeed -> Bool
$c<= :: DimNeed -> DimNeed -> Bool
< :: DimNeed -> DimNeed -> Bool
$c< :: DimNeed -> DimNeed -> Bool
compare :: DimNeed -> DimNeed -> Ordering
$ccompare :: DimNeed -> DimNeed -> Ordering
$cp1Ord :: Eq DimNeed
Ord)

-- | Size constraints in both dimensions.
type SpaceNeed = (DimNeed, DimNeed)

-- | The amount of space actually used by a widget.
type SpaceUse = [Rectangle]

-- | Externally-imposed optional minimum and maximum values for width
-- and height.
type Constraints = ( (Maybe Integer, Maybe Integer)
                   , (Maybe Integer, Maybe Integer))

-- | @constrainNeed need constraints@ reduces the space requirement
-- given by @need@ in order to fulfill @constraints@.
constrainNeed :: SpaceNeed -> Constraints -> SpaceNeed
constrainNeed :: SpaceNeed -> Constraints -> SpaceNeed
constrainNeed (DimNeed
wreq, DimNeed
hreq) ((Maybe Integer
minw, Maybe Integer
maxw), (Maybe Integer
minh, Maybe Integer
maxh)) =
  (DimNeed -> Maybe Integer -> Maybe Integer -> DimNeed
f DimNeed
wreq Maybe Integer
minw Maybe Integer
maxw, DimNeed -> Maybe Integer -> Maybe Integer -> DimNeed
f DimNeed
hreq Maybe Integer
minh Maybe Integer
maxh)
    where f :: DimNeed -> Maybe Integer -> Maybe Integer -> DimNeed
f DimNeed
x Maybe Integer
Nothing Maybe Integer
Nothing = DimNeed
x
          f (Max Integer
x) (Just Integer
y) Maybe Integer
_ | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
y = Integer -> DimNeed
Min Integer
x
          f (Max Integer
_) (Just Integer
y) Maybe Integer
_ = Integer -> DimNeed
Max Integer
y
          f (Min Integer
x) (Just Integer
y) Maybe Integer
_ = Integer -> DimNeed
Min (Integer -> DimNeed) -> Integer -> DimNeed
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
x Integer
y
          f DimNeed
_ (Just Integer
y) Maybe Integer
_ = Integer -> DimNeed
Min Integer
y
          f DimNeed
_ Maybe Integer
_ (Just Integer
y) = Integer -> DimNeed
Max Integer
y

-- | @fitRect rect need@ yields a rectangle as large as possible, but
-- no larger than @rect@, that tries to fulfill the constraints
-- @need@.
fitRect :: Rectangle -> SpaceNeed -> Rectangle
fitRect :: Rectangle -> SpaceNeed -> Rectangle
fitRect (Rectangle Integer
x Integer
y Integer
w Integer
h) (DimNeed
wn, DimNeed
hn) =
  Integer -> Integer -> Integer -> Integer -> Rectangle
Rectangle Integer
x Integer
y (Integer -> DimNeed -> Integer
fit Integer
w DimNeed
wn) (Integer -> DimNeed -> Integer
fit Integer
h DimNeed
hn)
    where fit :: Integer -> DimNeed -> Integer
fit Integer
d DimNeed
dn = case DimNeed
dn of
                      Max Integer
dn'   -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
d Integer
dn'
                      Min Integer
_     -> Integer
d
                      Exact Integer
ev  -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
d Integer
ev
                      DimNeed
Unlimited -> Integer
d

-- | Instruction on how to align a smaller interval within a larger
-- interval.
data Align = AlignNeg -- ^ Align towards negative infinity.
           | AlignPos -- ^ Align towards positive infinity.
           | AlignCenter -- ^ Align towards the center of the interval.
             deriving (Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show, Align -> Align -> Bool
(Align -> Align -> Bool) -> (Align -> Align -> Bool) -> Eq Align
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c== :: Align -> Align -> Bool
Eq)

-- | @align a lower x upper@, where @lower<=upper@, aligns a
-- subinterval of length @x@ in the interval @lower@ to @upper@,
-- returning the coordinate at which the aligned subinterval starts.
-- For example,
--
-- >>> align AlignCenter 2 4 10
-- 4
-- >>> align AlignNeg 2 4 10
-- 2
-- >>> align AlignPos 2 4 10
-- 6
align :: Integral a => Align -> a -> a -> a -> a
align :: Align -> a -> a -> a -> a
align Align
AlignCenter a
minp a
d a
maxp = a
minp a -> a -> a
forall a. Num a => a -> a -> a
+ (a
maxp a -> a -> a
forall a. Num a => a -> a -> a
- a
minp a -> a -> a
forall a. Num a => a -> a -> a
- a
d) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
align Align
AlignNeg a
minp a
_ a
_ = a
minp
align Align
AlignPos a
_ a
d a
maxp = a
maxp a -> a -> a
forall a. Num a => a -> a -> a
- a
d

-- | @adjustRect (walign, halign) bigrect smallrect@ returns a
-- rectangle with the same dimensions as @smallrect@ aligned within
-- @bigrect@ in both dimensions.
adjustRect :: (Align, Align) -> Rectangle -> Rectangle -> Rectangle
adjustRect :: (Align, Align) -> Rectangle -> Rectangle -> Rectangle
adjustRect (Align
walign, Align
halign) (Rectangle Integer
sx Integer
sy Integer
sw Integer
sh) (Rectangle Integer
_ Integer
_ Integer
w Integer
h) =
    Integer -> Integer -> Integer -> Integer -> Rectangle
Rectangle Integer
cx' Integer
cy' Integer
w Integer
h
    where cx' :: Integer
cx' = Align -> Integer -> Integer -> Integer -> Integer
forall a. Integral a => Align -> a -> a -> a -> a
frob Align
walign Integer
sx Integer
w Integer
sw
          cy' :: Integer
cy' = Align -> Integer -> Integer -> Integer -> Integer
forall a. Integral a => Align -> a -> a -> a -> a
frob Align
halign Integer
sy Integer
h Integer
sh
          frob :: Align -> a -> a -> a -> a
frob Align
AlignCenter a
c a
d a
maxv = a
c a -> a -> a
forall a. Num a => a -> a -> a
+ (a
maxv a -> a -> a
forall a. Num a => a -> a -> a
- a
d) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
          frob Align
AlignNeg a
c a
_ a
_ = a
c
          frob Align
AlignPos a
c a
d a
maxv = a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
maxv a -> a -> a
forall a. Num a => a -> a -> a
- a
d

-- | A keyboard modifier key.  The precise meaning (and location) of
-- these is somewhat platform-dependent.  Note that the @Shift@
-- modifier should not be passed along if the associated key is a
-- @CharKey@, as @Shift@ will already have been handled.
data KeyModifier = Control | Meta | Super | Hyper | Shift
                   deriving (KeyModifier -> KeyModifier -> Bool
(KeyModifier -> KeyModifier -> Bool)
-> (KeyModifier -> KeyModifier -> Bool) -> Eq KeyModifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyModifier -> KeyModifier -> Bool
$c/= :: KeyModifier -> KeyModifier -> Bool
== :: KeyModifier -> KeyModifier -> Bool
$c== :: KeyModifier -> KeyModifier -> Bool
Eq, Eq KeyModifier
Eq KeyModifier
-> (KeyModifier -> KeyModifier -> Ordering)
-> (KeyModifier -> KeyModifier -> Bool)
-> (KeyModifier -> KeyModifier -> Bool)
-> (KeyModifier -> KeyModifier -> Bool)
-> (KeyModifier -> KeyModifier -> Bool)
-> (KeyModifier -> KeyModifier -> KeyModifier)
-> (KeyModifier -> KeyModifier -> KeyModifier)
-> Ord KeyModifier
KeyModifier -> KeyModifier -> Bool
KeyModifier -> KeyModifier -> Ordering
KeyModifier -> KeyModifier -> KeyModifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyModifier -> KeyModifier -> KeyModifier
$cmin :: KeyModifier -> KeyModifier -> KeyModifier
max :: KeyModifier -> KeyModifier -> KeyModifier
$cmax :: KeyModifier -> KeyModifier -> KeyModifier
>= :: KeyModifier -> KeyModifier -> Bool
$c>= :: KeyModifier -> KeyModifier -> Bool
> :: KeyModifier -> KeyModifier -> Bool
$c> :: KeyModifier -> KeyModifier -> Bool
<= :: KeyModifier -> KeyModifier -> Bool
$c<= :: KeyModifier -> KeyModifier -> Bool
< :: KeyModifier -> KeyModifier -> Bool
$c< :: KeyModifier -> KeyModifier -> Bool
compare :: KeyModifier -> KeyModifier -> Ordering
$ccompare :: KeyModifier -> KeyModifier -> Ordering
$cp1Ord :: Eq KeyModifier
Ord, Int -> KeyModifier -> ShowS
[KeyModifier] -> ShowS
KeyModifier -> String
(Int -> KeyModifier -> ShowS)
-> (KeyModifier -> String)
-> ([KeyModifier] -> ShowS)
-> Show KeyModifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyModifier] -> ShowS
$cshowList :: [KeyModifier] -> ShowS
show :: KeyModifier -> String
$cshow :: KeyModifier -> String
showsPrec :: Int -> KeyModifier -> ShowS
$cshowsPrec :: Int -> KeyModifier -> ShowS
Show)

-- | Either a key corresponding to a visible character, or a control
-- key not associated with any character.
data Key = CharKey Char -- ^ Unicode character associated with the key.
         | CtrlKey String -- ^ Name of the control key, using X11
                          -- key names (for example @BackSpace@ or
                          -- @Return@).
    deriving (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord)

-- | A combination of a set of modifier keys and a primary key,
-- representing a complete piece of keyboard input.
type Chord = (S.Set KeyModifier, Key)

-- | Low-level reference to an object.
type ObjectNum = Int
-- | High-level reference to an object, containing its class and name
-- (if any) as well.  For non-widgets, the object name is the same as
-- the object class.
type ObjectRef = (ObjectNum, Identifier, Maybe Identifier)
-- | High-level reference to a widget.
type WidgetRef = ObjectRef

-- | The type of names (such as variables and classes) in the syntax
-- tree.
type Identifier = String

-- | Dynamically typed run-time value in the Sindre language.
data Value = StringV T.Text
           | Number Double
           | Reference ObjectRef
           | Dict (M.Map Value Value)
             deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmax :: Value -> Value -> Value
>= :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c< :: Value -> Value -> Bool
compare :: Value -> Value -> Ordering
$ccompare :: Value -> Value -> Ordering
$cp1Ord :: Eq Value
Ord)

instance Show Value where
  show :: Value -> String
show (Number Double
v) = if Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
v' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
v then Integer -> String
forall a. Show a => a -> String
show Integer
v'
                    else Double -> String
forall a. Show a => a -> String
show Double
v
                      where v' :: Integer
v' = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Double
v
  show (Reference (Int
_,String
_,Just String
k)) = String
k
  show (Reference (Int
r,String
c,Maybe String
Nothing)) = String
"#<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  show (Dict Map Value Value
m) = String
"#<dictionary with "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (Map Value Value -> Int
forall k a. Map k a -> Int
M.size Map Value Value
m)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" entries>"
  show (StringV Text
v) = Text -> String
T.unpack Text
v

-- | @string s@ returns a Sindre string.
string :: String -> Value
string :: String -> Value
string = Text -> Value
StringV (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | @true v@ returns 'True' if @v@ is interpreted as a true value in
-- Sindre, 'False' otherwise.
true :: Value -> Bool
true :: Value -> Bool
true (Number Double
0) = Bool
False
true (StringV Text
s) = Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
T.empty
true (Dict Map Value Value
m) = Map Value Value
m Map Value Value -> Map Value Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Map Value Value
forall k a. Map k a
M.empty
true Value
_ = Bool
True

-- | Canonical false value, see 'true'.
truth, falsity :: Value
-- ^ Canonical true value, see 'true'.
truth :: Value
truth = Double -> Value
Number Double
1
falsity :: Value
falsity = Double -> Value
Number Double
0

-- | A position in a source file, consisting of a file name,
-- one-indexed line number, and one-indexed column number.
type SourcePos = (String, Int, Int)

-- | A default position when no other is available.
nowhere :: SourcePos
nowhere :: SourcePos
nowhere = (String
"<nowhere>", Int
0, Int
0)

-- | Prettyprint a source position in a human-readable form.
--
-- >>> position ("foobar.sindre", 5, 15)
-- "foobar.sindre:5:15: "
position :: SourcePos -> String
position :: SourcePos -> String
position (String
file, Int
line, Int
col) =
  String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "

-- | Wrap a value with source position information.
data P a = P { P a -> SourcePos
sourcePos :: SourcePos, P a -> a
unP :: a }
    deriving (Int -> P a -> ShowS
[P a] -> ShowS
P a -> String
(Int -> P a -> ShowS)
-> (P a -> String) -> ([P a] -> ShowS) -> Show (P a)
forall a. Show a => Int -> P a -> ShowS
forall a. Show a => [P a] -> ShowS
forall a. Show a => P a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [P a] -> ShowS
$cshowList :: forall a. Show a => [P a] -> ShowS
show :: P a -> String
$cshow :: forall a. Show a => P a -> String
showsPrec :: Int -> P a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> P a -> ShowS
Show, P a -> P a -> Bool
(P a -> P a -> Bool) -> (P a -> P a -> Bool) -> Eq (P a)
forall a. Eq a => P a -> P a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: P a -> P a -> Bool
$c/= :: forall a. Eq a => P a -> P a -> Bool
== :: P a -> P a -> Bool
$c== :: forall a. Eq a => P a -> P a -> Bool
Eq, Eq (P a)
Eq (P a)
-> (P a -> P a -> Ordering)
-> (P a -> P a -> Bool)
-> (P a -> P a -> Bool)
-> (P a -> P a -> Bool)
-> (P a -> P a -> Bool)
-> (P a -> P a -> P a)
-> (P a -> P a -> P a)
-> Ord (P a)
P a -> P a -> Bool
P a -> P a -> Ordering
P a -> P a -> P a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (P a)
forall a. Ord a => P a -> P a -> Bool
forall a. Ord a => P a -> P a -> Ordering
forall a. Ord a => P a -> P a -> P a
min :: P a -> P a -> P a
$cmin :: forall a. Ord a => P a -> P a -> P a
max :: P a -> P a -> P a
$cmax :: forall a. Ord a => P a -> P a -> P a
>= :: P a -> P a -> Bool
$c>= :: forall a. Ord a => P a -> P a -> Bool
> :: P a -> P a -> Bool
$c> :: forall a. Ord a => P a -> P a -> Bool
<= :: P a -> P a -> Bool
$c<= :: forall a. Ord a => P a -> P a -> Bool
< :: P a -> P a -> Bool
$c< :: forall a. Ord a => P a -> P a -> Bool
compare :: P a -> P a -> Ordering
$ccompare :: forall a. Ord a => P a -> P a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (P a)
Ord, a -> P b -> P a
(a -> b) -> P a -> P b
(forall a b. (a -> b) -> P a -> P b)
-> (forall a b. a -> P b -> P a) -> Functor P
forall a b. a -> P b -> P a
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> P b -> P a
$c<$ :: forall a b. a -> P b -> P a
fmap :: (a -> b) -> P a -> P b
$cfmap :: forall a b. (a -> b) -> P a -> P b
Functor)

-- | @x `at` y@ gives a value containing @x@, but with the same source
-- position as @y@.
at :: a -> P b -> P a
at :: a -> P b -> P a
at a
e1 P b
e2 = a -> b -> a
forall a b. a -> b -> a
const a
e1 (b -> a) -> P b -> P a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P b
e2

-- | The syntax of Sindre statements.
data Stmt = Print [P Expr]
          | Exit (Maybe (P Expr))
          | Return (Maybe (P Expr))
          | Next
          | If (P Expr) [P Stmt] [P Stmt]
          | While (P Expr) [P Stmt]
          | For (P Expr) (P Expr) (P Expr) [P Stmt]
          | Do [P Stmt] (P Expr)
          | Break
          | Continue
          | Expr (P Expr)
          | Focus (P Expr)
            deriving (Int -> Stmt -> ShowS
[Stmt] -> ShowS
Stmt -> String
(Int -> Stmt -> ShowS)
-> (Stmt -> String) -> ([Stmt] -> ShowS) -> Show Stmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stmt] -> ShowS
$cshowList :: [Stmt] -> ShowS
show :: Stmt -> String
$cshow :: Stmt -> String
showsPrec :: Int -> Stmt -> ShowS
$cshowsPrec :: Int -> Stmt -> ShowS
Show, Stmt -> Stmt -> Bool
(Stmt -> Stmt -> Bool) -> (Stmt -> Stmt -> Bool) -> Eq Stmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stmt -> Stmt -> Bool
$c/= :: Stmt -> Stmt -> Bool
== :: Stmt -> Stmt -> Bool
$c== :: Stmt -> Stmt -> Bool
Eq)

-- | The syntax of Sindre expressions.
data Expr = Literal Value
          | Var Identifier
          | FieldOf Identifier (P Expr)
          | Lookup (P Expr) (P Expr)
          | Not (P Expr)
          | LessThan (P Expr) (P Expr)
          | LessEql (P Expr) (P Expr)
          | Equal (P Expr) (P Expr)
          | Assign (P Expr) (P Expr)
          | PostInc (P Expr)
          | PostDec (P Expr)
          | Concat (P Expr) (P Expr)
          | Plus (P Expr) (P Expr)
          | Minus (P Expr) (P Expr)
          | Times (P Expr) (P Expr)
          | Divided (P Expr) (P Expr)
          | Modulo (P Expr) (P Expr)
          | RaisedTo (P Expr) (P Expr)
          | Funcall Identifier [P Expr]
          | Methcall (P Expr) Identifier [P Expr]
          | Cond (P Expr) (P Expr) (P Expr)
            deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, Eq Expr
Eq Expr
-> (Expr -> Expr -> Ordering)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> Ord Expr
Expr -> Expr -> Bool
Expr -> Expr -> Ordering
Expr -> Expr -> Expr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Expr -> Expr -> Expr
$cmin :: Expr -> Expr -> Expr
max :: Expr -> Expr -> Expr
$cmax :: Expr -> Expr -> Expr
>= :: Expr -> Expr -> Bool
$c>= :: Expr -> Expr -> Bool
> :: Expr -> Expr -> Bool
$c> :: Expr -> Expr -> Bool
<= :: Expr -> Expr -> Bool
$c<= :: Expr -> Expr -> Bool
< :: Expr -> Expr -> Bool
$c< :: Expr -> Expr -> Bool
compare :: Expr -> Expr -> Ordering
$ccompare :: Expr -> Expr -> Ordering
$cp1Ord :: Eq Expr
Ord)

-- | Something that happened in the world.
data Event = KeyPress Chord
           | NamedEvent { Event -> String
eventName   :: Identifier  -- ^ The name of the event.
                        , Event -> [Value]
eventValue  :: [Value]     -- ^ The payload of the event.
                        , Event -> EventSource
eventSource :: EventSource -- ^ Where it's from.
                        }
             deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

-- | The origin of an event.  This is used when determining where to
-- handle it.
data EventSource = FieldSrc ObjectRef Identifier
                   -- ^ @FieldSrc obj f@ designates that the source of
                   -- the event is the property @f@ of @obj@
                 | ObjectSrc ObjectRef -- ^ The source is the given object.
                 | BackendSrc -- ^ The source is something within the
                              -- bowels of the active backend,
                              -- probably from the external world.
        deriving (Int -> EventSource -> ShowS
[EventSource] -> ShowS
EventSource -> String
(Int -> EventSource -> ShowS)
-> (EventSource -> String)
-> ([EventSource] -> ShowS)
-> Show EventSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventSource] -> ShowS
$cshowList :: [EventSource] -> ShowS
show :: EventSource -> String
$cshow :: EventSource -> String
showsPrec :: Int -> EventSource -> ShowS
$cshowsPrec :: Int -> EventSource -> ShowS
Show)

-- | Description of sets of sources, values of this type can be used
-- to pattern-match @EventSource@s.
data SourcePat = NamedSource Identifier (Maybe Identifier)
               -- ^ For @NamedSource k fk@, the source must be the
               -- object named @k@.  If @fk@ is @Just fk'@, the source
               -- must also be the field named @fk'@.
               | GenericSource Identifier Identifier (Maybe Identifier)
                 -- ^ For @GenericSource cn k fk@, the source must be
                 -- of class @cn@.  If @fk@ is @Just fk'@, the source
                 -- must also be the field named @fk'@.  The variable
                 -- named @k@ should be bound to the actual object if
                 -- this pattern matches.
                 deriving (SourcePat -> SourcePat -> Bool
(SourcePat -> SourcePat -> Bool)
-> (SourcePat -> SourcePat -> Bool) -> Eq SourcePat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePat -> SourcePat -> Bool
$c/= :: SourcePat -> SourcePat -> Bool
== :: SourcePat -> SourcePat -> Bool
$c== :: SourcePat -> SourcePat -> Bool
Eq, Eq SourcePat
Eq SourcePat
-> (SourcePat -> SourcePat -> Ordering)
-> (SourcePat -> SourcePat -> Bool)
-> (SourcePat -> SourcePat -> Bool)
-> (SourcePat -> SourcePat -> Bool)
-> (SourcePat -> SourcePat -> Bool)
-> (SourcePat -> SourcePat -> SourcePat)
-> (SourcePat -> SourcePat -> SourcePat)
-> Ord SourcePat
SourcePat -> SourcePat -> Bool
SourcePat -> SourcePat -> Ordering
SourcePat -> SourcePat -> SourcePat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourcePat -> SourcePat -> SourcePat
$cmin :: SourcePat -> SourcePat -> SourcePat
max :: SourcePat -> SourcePat -> SourcePat
$cmax :: SourcePat -> SourcePat -> SourcePat
>= :: SourcePat -> SourcePat -> Bool
$c>= :: SourcePat -> SourcePat -> Bool
> :: SourcePat -> SourcePat -> Bool
$c> :: SourcePat -> SourcePat -> Bool
<= :: SourcePat -> SourcePat -> Bool
$c<= :: SourcePat -> SourcePat -> Bool
< :: SourcePat -> SourcePat -> Bool
$c< :: SourcePat -> SourcePat -> Bool
compare :: SourcePat -> SourcePat -> Ordering
$ccompare :: SourcePat -> SourcePat -> Ordering
$cp1Ord :: Eq SourcePat
Ord, Int -> SourcePat -> ShowS
[SourcePat] -> ShowS
SourcePat -> String
(Int -> SourcePat -> ShowS)
-> (SourcePat -> String)
-> ([SourcePat] -> ShowS)
-> Show SourcePat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourcePat] -> ShowS
$cshowList :: [SourcePat] -> ShowS
show :: SourcePat -> String
$cshow :: SourcePat -> String
showsPrec :: Int -> SourcePat -> ShowS
$cshowsPrec :: Int -> SourcePat -> ShowS
Show)

-- | A description of an event used to indicate how to handle
-- different events.
data Pattern = ChordPattern Chord -- ^ Match if the event is a chord.
             | OrPattern Pattern Pattern -- ^ Match if either pattern
                                         -- matches.
             | SourcedPattern { Pattern -> SourcePat
patternSource :: SourcePat
                              , Pattern -> String
patternEvent  :: Identifier
                              , Pattern -> [String]
patternVars   :: [Identifier]
                              }
               -- ^ @SourcedPattern src ev vars@ matches if @src@
               -- matches the event source (see 'SourcePat') an @ev@
               -- matches the event name.  @vars@ should be bound to
               -- the values in the payload of the event.
               deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq, Eq Pattern
Eq Pattern
-> (Pattern -> Pattern -> Ordering)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Pattern)
-> (Pattern -> Pattern -> Pattern)
-> Ord Pattern
Pattern -> Pattern -> Bool
Pattern -> Pattern -> Ordering
Pattern -> Pattern -> Pattern
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pattern -> Pattern -> Pattern
$cmin :: Pattern -> Pattern -> Pattern
max :: Pattern -> Pattern -> Pattern
$cmax :: Pattern -> Pattern -> Pattern
>= :: Pattern -> Pattern -> Bool
$c>= :: Pattern -> Pattern -> Bool
> :: Pattern -> Pattern -> Bool
$c> :: Pattern -> Pattern -> Bool
<= :: Pattern -> Pattern -> Bool
$c<= :: Pattern -> Pattern -> Bool
< :: Pattern -> Pattern -> Bool
$c< :: Pattern -> Pattern -> Bool
compare :: Pattern -> Pattern -> Ordering
$ccompare :: Pattern -> Pattern -> Ordering
$cp1Ord :: Eq Pattern
Ord, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)

-- | A function consists of lexically bound parameters and a body.
data Function = Function [Identifier] [P Stmt]
              deriving (Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function] -> ShowS
$cshowList :: [Function] -> ShowS
show :: Function -> String
$cshow :: Function -> String
showsPrec :: Int -> Function -> ShowS
$cshowsPrec :: Int -> Function -> ShowS
Show, Function -> Function -> Bool
(Function -> Function -> Bool)
-> (Function -> Function -> Bool) -> Eq Function
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Function -> Function -> Bool
$c/= :: Function -> Function -> Bool
== :: Function -> Function -> Bool
$c== :: Function -> Function -> Bool
Eq)

-- | Reaction to an event.
data Action = StmtAction [P Stmt] -- ^ Execute these statements.
              deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

-- | Widget arguments are key-value pairs, with a unique value for
-- each key.
type WidgetArgs = M.Map Identifier (P Expr)

-- | A Sindre GUI is a recursive tree, with each node representing a
-- single widget and consisting of the following fields.
data GUI = GUI {
      GUI -> Maybe String
widgetName :: Maybe Identifier -- ^ Name of the widget, if any.
    , GUI -> P String
widgetClass :: P Identifier -- ^ Class of the widget.
    , GUI -> WidgetArgs
widgetArgs :: WidgetArgs -- ^ The arguments passed to the widget.
    , GUI -> [(Maybe (P Expr), GUI)]
widgetChildren :: [(Maybe (P Expr), GUI)] -- ^ Children of the widget, if any.
    } deriving (Int -> GUI -> ShowS
[GUI] -> ShowS
GUI -> String
(Int -> GUI -> ShowS)
-> (GUI -> String) -> ([GUI] -> ShowS) -> Show GUI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GUI] -> ShowS
$cshowList :: [GUI] -> ShowS
show :: GUI -> String
$cshow :: GUI -> String
showsPrec :: Int -> GUI -> ShowS
$cshowsPrec :: Int -> GUI -> ShowS
Show)

-- | A command line argument.
type SindreOption = OptDescr (Arguments -> Arguments)
-- | The arguments passed to the Sindre program from the command line.
type Arguments = M.Map String String

-- | A complete Sindre program.  Note that this is intentionally
-- defined such that some invalid programs, like those with duplicate
-- definitions can be represented - the compiler (see
-- "Sindre.Compiler") should detect and handle such errors.
data Program = Program {
      Program -> (Maybe (P Expr), GUI)
programGUI       :: (Maybe (P Expr), GUI)
    , Program -> [P (Pattern, Action)]
programActions   :: [P (Pattern, Action)]
    , Program -> [P (String, P Expr)]
programGlobals   :: [P (Identifier, P Expr)]
    , Program -> [P (String, (SindreOption, Maybe Value))]
programOptions   :: [P (Identifier, (SindreOption, Maybe Value))]
    , Program -> [P (String, Function)]
programFunctions :: [P (Identifier, Function)]
    , Program -> [P Stmt]
programBegin     :: [P Stmt] -- ^ The contents of the @BEGIN@ block.
    }