Parse.hs (1514B)
1 {-# LANGUAGE ApplicativeDo #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 4 module Nock.Parse ( 5 P.runParser 6 7 , parse 8 , expr 9 ) where 10 11 import Nock.Language 12 import Control.Applicative ((<|>)) 13 import qualified Data.Text as T 14 import qualified Text.Parsec as P 15 16 parse :: T.Text -> Either P.ParseError Expr 17 parse = P.runParser expr [] "input" 18 19 expr :: Monad m => P.ParsecT T.Text u m Expr 20 expr = 21 P.try operator 22 <|> fmap Noun noun 23 24 operator :: Monad m => P.ParsecT T.Text u m Expr 25 operator = do 26 op <- P.oneOf "?+=/#*" 27 case op of 28 '?' -> fmap Wut noun 29 '+' -> fmap Lus noun 30 '=' -> fmap Tis noun 31 '/' -> fmap Net noun 32 '#' -> fmap Hax noun 33 '*' -> fmap Tar noun 34 _ -> fail "op: bad token" 35 36 noun :: Monad m => P.ParsecT T.Text u m Noun 37 noun = 38 P.try cell 39 <|> atom 40 41 atom :: Monad m => P.ParsecT T.Text u m Noun 42 atom = do 43 digits <- P.many P.digit 44 case digits of 45 ('0':t) -> case t of 46 [] -> return (Atom 0) 47 _ -> fail "atom: bad input" 48 49 (_:_) -> 50 let nat = read digits 51 in return (Atom nat) 52 53 [] -> fail "atom: bad input" 54 55 cell :: Monad m => P.ParsecT T.Text u m Noun 56 cell = do 57 P.char '[' 58 P.skipMany P.space 59 h <- noun 60 P.skipMany P.space 61 t <- P.sepBy noun (P.many1 P.space) 62 P.skipMany P.space 63 P.char ']' 64 65 return (toCell (h : t)) 66 67 toCell :: [Noun] -> Noun 68 toCell = loop where 69 loop list = case list of 70 [] -> error "cell: bad input" 71 [_] -> error "cell: bad input" 72 [s, f] -> Cell s f 73 (h:t) -> Cell h (loop t) 74