103 lines
2.8 KiB
Text
103 lines
2.8 KiB
Text
module Main where
|
|
|
|
import Prelude
|
|
import Effect (Effect)
|
|
import Effect.Console (log)
|
|
|
|
import Data.Maybe (Maybe(..))
|
|
import Data.Tuple (Tuple(..))
|
|
import Data.String.CodeUnits (uncons)
|
|
|
|
newtype Parser v = Parser (String -> Maybe (Tuple v String))
|
|
parse :: forall a. Parser a -> (String -> Maybe (Tuple a String))
|
|
parse (Parser p) = p
|
|
|
|
itemP :: Parser Char
|
|
itemP = Parser p
|
|
where p str = case uncons str of
|
|
Nothing -> Nothing
|
|
Just { head: x, tail: xs } -> Just (Tuple x xs)
|
|
|
|
instance functorParser :: Functor Parser where
|
|
map f (Parser p) =
|
|
Parser $ \s0 -> do
|
|
(Tuple x s1) <- p s0
|
|
pure (Tuple (f x) s1)
|
|
|
|
instance applyParser :: Apply Parser where
|
|
apply (Parser p1) (Parser p2)
|
|
= Parser $ \str -> case p1 str of
|
|
Nothing -> Nothing
|
|
Just (Tuple x1 xs1) -> case p2 xs1 of
|
|
Nothing -> Nothing
|
|
Just (Tuple x2 xs2) -> Just (Tuple (x1 x2) xs2)
|
|
|
|
instance applicativeParser :: Applicative Parser where
|
|
pure a = Parser $ \str -> Just (Tuple a str)
|
|
|
|
instance bindParser :: Bind Parser where
|
|
bind (Parser p) f = Parser $ \str -> case p str of
|
|
Nothing -> Nothing
|
|
Just (Tuple x xs) ->
|
|
let (Parser p2) = f x
|
|
in p2 xs
|
|
|
|
isf :: Parser Boolean
|
|
isf = (_ == 'f') <$> itemP
|
|
|
|
isf2 :: Parser Boolean
|
|
isf2 = (==) <$> itemP <*> pure 'f'
|
|
|
|
ishi :: Parser (Tuple Boolean Boolean)
|
|
ishi = Tuple <$> ((_ == 'h') <$> itemP) <*> ((_ == 'i') <$> itemP)
|
|
|
|
ishi2 :: Parser (Tuple Boolean Boolean)
|
|
ishi2 = ado
|
|
h <- itemP
|
|
i <- itemP
|
|
in Tuple (h == 'h') (i == 'i')
|
|
|
|
isffound :: Maybe (Tuple Boolean String) -> Effect Unit
|
|
isffound maybe = case maybe of
|
|
Nothing -> log "no more data"
|
|
Just (Tuple b str) -> do
|
|
let toprint = if b then "FOUND IT" else "not found"
|
|
log $ toprint <> ", rest: " <> str
|
|
|
|
main :: Effect Unit
|
|
main = do
|
|
log "🍝"
|
|
|
|
case parse ishi2 "hi" of
|
|
Just (Tuple x y) -> log ("parsing 'hi': " <> show x <> " " <> show y)
|
|
Nothing -> log "coudn't parse two letters"
|
|
|
|
case parse ishi2 "no" of
|
|
Just (Tuple x y) -> log ("parsing 'no': " <> show x <> " " <> show y)
|
|
Nothing -> log "coudn't parse two letters"
|
|
|
|
case parse ishi2 "ho" of
|
|
Just (Tuple x y) -> log ("parsing 'ho': " <> show x <> " " <> show y)
|
|
Nothing -> log "coudn't parse two letters"
|
|
|
|
case parse ishi2 "ni" of
|
|
Just (Tuple x y) -> log ("parsing 'ni': " <> show x <> " " <> show y)
|
|
Nothing -> log "coudn't parse two letters"
|
|
|
|
case parse ishi2 "" of
|
|
Just (Tuple x y) -> log ("parsing '': " <> show x <> " " <> show y)
|
|
Nothing -> log "coudn't parse two letters"
|
|
|
|
|
|
-- JUST WORKS
|
|
-- isffound $ parse isf "fable"
|
|
-- isffound $ parse isf "f"
|
|
-- isffound $ parse isf "n"
|
|
-- isffound $ parse isf ""
|
|
--
|
|
-- isffound $ parse isf2 "fable"
|
|
-- isffound $ parse isf2 "f"
|
|
-- isffound $ parse isf2 "n"
|
|
-- isffound $ parse isf2 ""
|
|
|
|
log "end"
|