Исходный текст программы "Счастливые билеты".

bobo="This programm demonstrate the graphical\n realization of problem Happy Tickets. You may\n test yourself and suggest your expression."
ex :: IO ()
ex = start$
do w<-window [title "Happy tickets"]
cl<-clipboard [initValue [("",0),("",0)]]
cl1<-clipboard [initValue ["",""]]
l1<-label[width 30,relief "ridge",text "Enter ticket"] w
l2<-label[width 30,relief "ridge",text "Enter number"] w
e1<-entry[width 30,relief "ridge",initValue "",background (rgb 145 167 156)] w
e2<-entry[width 30,relief "ridge",initValue 100,background (rgb 23 245 45)] w
b<-button[text "Quit",command quit,background (rgb 145 167 178)] w
ab<-button[text "About",command (abo), background (rgb 145 167 178)] w
bm<-button[text "Solve",command (readEntry cl1 e1 e2), background (rgb 145 167 178)] w
te<-button[text "Test", command (test e1), background (rgb 145 167 178)] w
cset e1 (on return (readEntry cl1 e1 e2))
f<-frame [borderWidth 8,relief "ridge"] ((l1<Int
digitToInt s| s=='0'=0
| s=='1'=1
| s=='2'=2
| s=='3'=3
| s=='4'=4
| s=='5'=5
| s=='6'=6
| s=='7'=7
| s=='8'=8
| s=='9'=9
tickets ds = (ds, foldl (\n c -> 10*n + digitToInt c) 0 ds) :
[("("++ld++[op]++rd++")", f lv rv) |
(op,f) <- [('+',(+)),('-',(-)),('*',(*)),('/',(div))], n<-[1..length ds-1],
(ld,lv) <- tickets (take n ds), (rd,rv) <- tickets (drop n ds),
op /= '/' || (rv /= 0 && lv `mod` rv == 0)]
happy = map fst . (filter ((==)100 . snd)) . tickets
ads::[a]->a->[a]
ads s str=reverse(str:(reverse s))
getsec::(String,Int)->Int
getsec (s,c)=c
getfir::(String,Int)->String
getfir (s,c)=s
fi::[(String,Int)]->Int->[String]
fi (x:xs) n=if((getsec x)==n) then ((getfir x):(fi xs n)) else (fi xs n)
fi [] _=[]
hap::String->Int->String->[String]
hap str v =map fst. (filter((==)v.snd)).tickets --| s=='0'=0
isValidChar::Char->Bool
isValidChar s| s=='0'=True
| s=='1'=True
| s=='2'=True
| s=='3'=True
| s=='4'=True
| s=='5'=True
| s=='6'=True
| s=='7'=True
| s=='8'=True
| s=='9'=True
| s=='+'=True
| s=='-'=True
| s=='*'=True
| s=='/'=True
| s=='('=True
| s==')'=True
isValidChar _ =False
isValidString::String->Bool
isValidString (x:xs)=if((isValidChar x)) then (isValidString xs) else False
isValidString []=True
isValidDig s| s=='0'=True
| s=='1'=True
| s=='2'=True
| s=='3'=True
| s=='4'=True
| s=='5'=True
| s=='6'=True
| s=='7'=True
| s=='8'=True
| s=='9'=True
isValidDig _=False
isValidd::String->Bool
isValidd (x:xs)=if((isValidDig x)) then (isValidd xs) else False
isValidd []=True
infixr 6 &&&
infixl 5 >>>
infixr 4 |||

type Parser a = String -> [(a,String)]

resul :: a -> Parser a
resul x s = [(x,s)]

(|||) :: Parser a -> Parser a -> Parser a
(p ||| q) s = p s ++ q s

(&&&) :: Parser a -> Parser b -> Parser (a,b)
(p &&& q) s = [ ((x,y),s1) | (x,s0) <- p s, (y,s1) <- q s0 ]

(>>>) :: Parser a -> (a -> b) -> Parser b
(p >>> f) s = [ (f x, s0) | (x,s0) <- p s ]

many :: Parser a -> Parser [a]
many p = q where q = p &&& q >>> (\(x,xs) -> x:xs)
|||
resul []

many1 :: Parser a -> Parser [a]
many1 p = p &&& many p >>> (\(x,xs) -> x:xs)

sat :: (Char -> Bool) -> Parser Char
sat p (c:cs)
| p c = [ (c,cs) ]
sat p cs = []

tok :: String -> Parser String
tok s cs = loop s cs
where loop "" cs = [(s,cs)]
loop (s:ss) (c:cs) | s==c = loop ss cs
loop _ _ = []

digit :: Parser Int
digit = sat isDigit >>> digitToInt

number :: Parser Int
number = many1 digit >>> foldl (\a x -> 10*a+x) 0

atom = tok "-" &&& number >>> (\(u,n) -> -n) |||
number |||
tok "(" &&& expr &&& tok ")" >>> (\(o,(n,c)) -> n)

expr = term &&& (tok "+" &&& expr >>> (\(p,y) -> (+y)) |||
tok "-" &&& expr >>> (\(m,y) -> subtract y) |||
resul id) >>> \(n,f) -> f n

term = atom &&& (tok "*" &&& term >>> (\(t,y) -> (*y)) |||
tok "/" &&& term >>> (\(d,y) -> (`div` y)) |||
resul id) >>> \(n,f) -> f n

eval s = case expr s of ((x,""):_) -> x
_ -> error "You mistake"
cou::String->Char->String
cou (x:xs) s=if(x==s) then (s:(cou xs s)) else (cou xs s)
cou [] _=[]