module Lambdabot.Plugin.Haskell.Pl.Common (
        Fixity(..), Expr(..), Pattern(..), Decl(..), TopLevel(..),
        bt, sizeExpr, mapTopLevel, getExpr,
        operators, opchars, reservedOps, lookupOp, lookupFix, minPrec, maxPrec,
        comp, flip', id', const', scomb, cons, nil, fix', if',
        makeList, getList, readM,
        Assoc(..),
        module Data.Maybe,
        module Control.Arrow,
        module Data.List,
        module Control.Monad,
        module GHC.Base
    ) where

import Data.Maybe (isJust, fromJust)
import Data.List (intersperse, minimumBy)
import qualified Data.Map as M

import Control.Applicative
import Control.Monad
import Control.Arrow (first, second, (***), (&&&), (|||), (+++))

import Text.ParserCombinators.Parsec.Expr (Assoc(..))

import GHC.Base (assert)


-- The rewrite rules can be found at the end of the file Rules.hs

-- Not sure if passing the information if it was used as infix or prefix
-- is worth threading through the whole thing is worth the effort,
-- but it stays that way until the prettyprinting algorithm gets more
-- sophisticated.
data Fixity = Pref | Inf deriving Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> String
$cshow :: Fixity -> String
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show

instance Eq Fixity where
  Fixity
_ == :: Fixity -> Fixity -> Bool
== Fixity
_ = Bool
True

instance Ord Fixity where
  compare :: Fixity -> Fixity -> Ordering
compare Fixity
_ Fixity
_ = Ordering
EQ

data Expr
  = Var Fixity String
  | Lambda Pattern Expr
  | App Expr Expr
  | Let [Decl] Expr
  deriving (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)

data Pattern
  = PVar String
  | PCons Pattern Pattern
  | PTuple Pattern Pattern
  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)

data Decl = Define {
  Decl -> String
declName :: String,
  Decl -> Expr
declExpr :: Expr
} deriving (Decl -> Decl -> Bool
(Decl -> Decl -> Bool) -> (Decl -> Decl -> Bool) -> Eq Decl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decl -> Decl -> Bool
$c/= :: Decl -> Decl -> Bool
== :: Decl -> Decl -> Bool
$c== :: Decl -> Decl -> Bool
Eq, Eq Decl
Eq Decl
-> (Decl -> Decl -> Ordering)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Decl)
-> (Decl -> Decl -> Decl)
-> Ord Decl
Decl -> Decl -> Bool
Decl -> Decl -> Ordering
Decl -> Decl -> Decl
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 :: Decl -> Decl -> Decl
$cmin :: Decl -> Decl -> Decl
max :: Decl -> Decl -> Decl
$cmax :: Decl -> Decl -> Decl
>= :: Decl -> Decl -> Bool
$c>= :: Decl -> Decl -> Bool
> :: Decl -> Decl -> Bool
$c> :: Decl -> Decl -> Bool
<= :: Decl -> Decl -> Bool
$c<= :: Decl -> Decl -> Bool
< :: Decl -> Decl -> Bool
$c< :: Decl -> Decl -> Bool
compare :: Decl -> Decl -> Ordering
$ccompare :: Decl -> Decl -> Ordering
$cp1Ord :: Eq Decl
Ord)

data TopLevel = TLD Bool Decl | TLE Expr deriving (TopLevel -> TopLevel -> Bool
(TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool) -> Eq TopLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopLevel -> TopLevel -> Bool
$c/= :: TopLevel -> TopLevel -> Bool
== :: TopLevel -> TopLevel -> Bool
$c== :: TopLevel -> TopLevel -> Bool
Eq, Eq TopLevel
Eq TopLevel
-> (TopLevel -> TopLevel -> Ordering)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> TopLevel)
-> (TopLevel -> TopLevel -> TopLevel)
-> Ord TopLevel
TopLevel -> TopLevel -> Bool
TopLevel -> TopLevel -> Ordering
TopLevel -> TopLevel -> TopLevel
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 :: TopLevel -> TopLevel -> TopLevel
$cmin :: TopLevel -> TopLevel -> TopLevel
max :: TopLevel -> TopLevel -> TopLevel
$cmax :: TopLevel -> TopLevel -> TopLevel
>= :: TopLevel -> TopLevel -> Bool
$c>= :: TopLevel -> TopLevel -> Bool
> :: TopLevel -> TopLevel -> Bool
$c> :: TopLevel -> TopLevel -> Bool
<= :: TopLevel -> TopLevel -> Bool
$c<= :: TopLevel -> TopLevel -> Bool
< :: TopLevel -> TopLevel -> Bool
$c< :: TopLevel -> TopLevel -> Bool
compare :: TopLevel -> TopLevel -> Ordering
$ccompare :: TopLevel -> TopLevel -> Ordering
$cp1Ord :: Eq TopLevel
Ord)

mapTopLevel :: (Expr -> Expr) -> TopLevel -> TopLevel
mapTopLevel :: (Expr -> Expr) -> TopLevel -> TopLevel
mapTopLevel Expr -> Expr
f TopLevel
tl = case TopLevel -> (Expr, Expr -> TopLevel)
getExpr TopLevel
tl of (Expr
e, Expr -> TopLevel
c) -> Expr -> TopLevel
c (Expr -> TopLevel) -> Expr -> TopLevel
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
f Expr
e

getExpr :: TopLevel -> (Expr, Expr -> TopLevel)
getExpr :: TopLevel -> (Expr, Expr -> TopLevel)
getExpr (TLD Bool
True (Define String
foo Expr
e)) = ([Decl] -> Expr -> Expr
Let [String -> Expr -> Decl
Define String
foo Expr
e] (Fixity -> String -> Expr
Var Fixity
Pref String
foo),
                                     \Expr
e' -> Bool -> Decl -> TopLevel
TLD Bool
False (Decl -> TopLevel) -> Decl -> TopLevel
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Decl
Define String
foo Expr
e')
getExpr (TLD Bool
False (Define String
foo Expr
e)) = (Expr
e, \Expr
e' -> Bool -> Decl -> TopLevel
TLD Bool
False (Decl -> TopLevel) -> Decl -> TopLevel
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Decl
Define String
foo Expr
e')
getExpr (TLE Expr
e)      = (Expr
e, Expr -> TopLevel
TLE)

sizeExpr :: Expr -> Int
sizeExpr :: Expr -> Int
sizeExpr (Var Fixity
_ String
_) = Int
1
sizeExpr (App Expr
e1 Expr
e2) = Expr -> Int
sizeExpr Expr
e1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
sizeExpr (Lambda Pattern
_ Expr
e) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e
sizeExpr (Let [Decl]
ds Expr
e) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Decl -> Int) -> [Decl] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Decl -> Int
sizeDecl [Decl]
ds) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e where
  sizeDecl :: Decl -> Int
sizeDecl (Define String
_ Expr
e') = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Expr -> Int
sizeExpr Expr
e'

comp, flip', id', const', scomb, cons, nil, fix', if' :: Expr
comp :: Expr
comp   = Fixity -> String -> Expr
Var Fixity
Inf  String
"."
flip' :: Expr
flip'  = Fixity -> String -> Expr
Var Fixity
Pref String
"flip"
id' :: Expr
id'    = Fixity -> String -> Expr
Var Fixity
Pref String
"id"
const' :: Expr
const' = Fixity -> String -> Expr
Var Fixity
Pref String
"const"
scomb :: Expr
scomb  = Fixity -> String -> Expr
Var Fixity
Pref String
"ap"
cons :: Expr
cons   = Fixity -> String -> Expr
Var Fixity
Inf  String
":"
nil :: Expr
nil    = Fixity -> String -> Expr
Var Fixity
Pref String
"[]"
fix' :: Expr
fix'   = Fixity -> String -> Expr
Var Fixity
Pref String
"fix"
if' :: Expr
if'    = Fixity -> String -> Expr
Var Fixity
Pref String
"if'"

makeList :: [Expr] -> Expr
makeList :: [Expr] -> Expr
makeList = (Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Expr
e1 Expr
e2 -> Expr
cons Expr -> Expr -> Expr
`App` Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2) Expr
nil

-- Modularity is a drag
getList :: Expr -> ([Expr], Expr)
getList :: Expr -> ([Expr], Expr)
getList (Expr
c `App` Expr
x `App` Expr
tl) | Expr
c Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
cons = ([Expr] -> [Expr]) -> ([Expr], Expr) -> ([Expr], Expr)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Expr
xExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:) (([Expr], Expr) -> ([Expr], Expr))
-> ([Expr], Expr) -> ([Expr], Expr)
forall a b. (a -> b) -> a -> b
$ Expr -> ([Expr], Expr)
getList Expr
tl
getList Expr
e = ([],Expr
e)

bt :: a
bt :: a
bt = a
forall a. HasCallStack => a
undefined

shift, minPrec, maxPrec :: Int
shift :: Int
shift = Int
0
maxPrec :: Int
maxPrec = Int
shift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
minPrec :: Int
minPrec = Int
0

-- operator precedences are needed both for parsing and prettyprinting
operators :: [[(String, (Assoc, Int))]]
operators :: [[(String, (Assoc, Int))]]
operators = (([(String, (Assoc, Int))] -> [(String, (Assoc, Int))])
-> [[(String, (Assoc, Int))]] -> [[(String, (Assoc, Int))]]
forall a b. (a -> b) -> [a] -> [b]
map (([(String, (Assoc, Int))] -> [(String, (Assoc, Int))])
 -> [[(String, (Assoc, Int))]] -> [[(String, (Assoc, Int))]])
-> ((Int -> Int)
    -> [(String, (Assoc, Int))] -> [(String, (Assoc, Int))])
-> (Int -> Int)
-> [[(String, (Assoc, Int))]]
-> [[(String, (Assoc, Int))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, (Assoc, Int)) -> (String, (Assoc, Int)))
-> [(String, (Assoc, Int))] -> [(String, (Assoc, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (((String, (Assoc, Int)) -> (String, (Assoc, Int)))
 -> [(String, (Assoc, Int))] -> [(String, (Assoc, Int))])
-> ((Int -> Int)
    -> (String, (Assoc, Int)) -> (String, (Assoc, Int)))
-> (Int -> Int)
-> [(String, (Assoc, Int))]
-> [(String, (Assoc, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Assoc, Int) -> (Assoc, Int))
-> (String, (Assoc, Int)) -> (String, (Assoc, Int))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Assoc, Int) -> (Assoc, Int))
 -> (String, (Assoc, Int)) -> (String, (Assoc, Int)))
-> ((Int -> Int) -> (Assoc, Int) -> (Assoc, Int))
-> (Int -> Int)
-> (String, (Assoc, Int))
-> (String, (Assoc, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> (Assoc, Int) -> (Assoc, Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Int -> Int)
 -> [[(String, (Assoc, Int))]] -> [[(String, (Assoc, Int))]])
-> (Int -> Int)
-> [[(String, (Assoc, Int))]]
-> [[(String, (Assoc, Int))]]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
shift))
  [[String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"." Assoc
AssocRight Int
9, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"!!" Assoc
AssocLeft Int
9],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name Assoc
AssocRight Int
8 | String
name <- [String
"^", String
"^^", String
"**"]],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name Assoc
AssocLeft Int
7
     | String
name <- [String
"*", String
"/", String
"`quot`", String
"`rem`", String
"`div`", String
"`mod`", String
":%", String
"%"]],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name Assoc
AssocLeft Int
6  | String
name <- [String
"+", String
"-"]],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name Assoc
AssocRight Int
5 | String
name <- [String
":", String
"++", String
"<+>"]],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name Assoc
AssocNone Int
4
     | String
name <- [String
"==", String
"/=", String
"<", String
"<=", String
">=", String
">", String
"`elem`", String
"`notElem`"]] [(String, (Assoc, Int))]
-> [(String, (Assoc, Int))] -> [(String, (Assoc, Int))]
forall a. [a] -> [a] -> [a]
++[String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name Assoc
AssocLeft Int
4 | String
name <- [String
"<*",String
"*>",String
"<$>",String
"<$",String
"<**>"]],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"&&" Assoc
AssocRight Int
3, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"***" Assoc
AssocRight Int
3, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"&&&" Assoc
AssocRight Int
3, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"<|>" Assoc
AssocLeft Int
3],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"||" Assoc
AssocRight Int
2, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"+++" Assoc
AssocRight Int
2, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"|||" Assoc
AssocRight Int
2],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
">>" Assoc
AssocLeft Int
1, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
">>=" Assoc
AssocLeft Int
1, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"=<<" Assoc
AssocRight Int
1, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
">>>" Assoc
AssocRight Int
1, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"^>>" Assoc
AssocRight Int
1, String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
"^<<" Assoc
AssocRight Int
1],
   [String -> Assoc -> Int -> (String, (Assoc, Int))
forall a a b. a -> a -> b -> (a, (a, b))
inf String
name Assoc
AssocRight Int
0 | String
name <- [String
"$", String
"$!", String
"`seq`"]]
  ] where
  inf :: a -> a -> b -> (a, (a, b))
inf a
name a
assoc b
fx = (a
name, (a
assoc, b
fx))

opchars :: [Char]
opchars :: String
opchars = String
"!@#$%^*./|=-+:?<>&"

reservedOps :: [String]
reservedOps :: [String]
reservedOps = [String
"->", String
"..", String
"="]

opFM :: M.Map String (Assoc, Int)
opFM :: Map String (Assoc, Int)
opFM = ([(String, (Assoc, Int))] -> Map String (Assoc, Int)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, (Assoc, Int))] -> Map String (Assoc, Int))
-> [(String, (Assoc, Int))] -> Map String (Assoc, Int)
forall a b. (a -> b) -> a -> b
$ [[(String, (Assoc, Int))]] -> [(String, (Assoc, Int))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, (Assoc, Int))]]
operators)

lookupOp :: String -> Maybe (Assoc, Int)
lookupOp :: String -> Maybe (Assoc, Int)
lookupOp String
k = String -> Map String (Assoc, Int) -> Maybe (Assoc, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String (Assoc, Int)
opFM

lookupFix :: String -> (Assoc, Int)
lookupFix :: String -> (Assoc, Int)
lookupFix String
str = case String -> Maybe (Assoc, Int)
lookupOp (String -> Maybe (Assoc, Int)) -> String -> Maybe (Assoc, Int)
forall a b. (a -> b) -> a -> b
$ String
str of
  Maybe (Assoc, Int)
Nothing -> (Assoc
AssocLeft, Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shift)
  Just (Assoc, Int)
x  -> (Assoc, Int)
x

readM :: (Read a, Alternative m) => String -> m a
readM :: String -> m a
readM String
str = case ReadS a
forall a. Read a => ReadS a
reads String
str of
   [(a
x, String
"")] -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
   [(a, String)]
_         -> m a
forall (f :: * -> *) a. Alternative f => f a
empty