Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 136 lines (103 sloc) 3.659 kb
12deabc initial version
alex authored
1 {-# OPTIONS_GHC -XTypeSynonymInstances -XOverlappingInstances -XIncoherentInstances -XOverloadedStrings -XFlexibleInstances #-}
2
3 module Parse where
4
5 import Text.ParserCombinators.Parsec
6 import qualified Text.ParserCombinators.Parsec.Token as P
7 import Text.ParserCombinators.Parsec.Language ( haskellDef )
8 import Pattern
e9fb83a @yaxu more there
authored
9 import Data.Ratio
12deabc initial version
alex authored
10
11 import GHC.Exts( IsString(..) )
12
13 class Parseable a where
14 p :: String -> Pattern a
15
16 instance Parseable Double where
17 p = parseRhythm pDouble
18
19 instance Parseable String where
20 p = parseRhythm pVocable
21
22 instance Parseable Bool where
23 p = parseRhythm pBool
24
25 instance Parseable Int where
26 p = parseRhythm pInt
27
28 -- type ColourD = Colour Double
29
30 -- instance Parseable ColourD where
31 -- p = parseRhythm pColour
32
33 instance (Parseable a) => IsString (Pattern a) where
34 fromString = p
35
36 lexer = P.makeTokenParser haskellDef
37 braces = P.braces lexer
38 brackets = P.brackets lexer
39 parens = P.parens lexer
df580f0 @yaxu foo
authored
40 angles = P.angles lexer
12deabc initial version
alex authored
41 symbol = P.symbol lexer
42 natural = P.natural lexer
43 float = P.float lexer
44 naturalOrFloat = P.naturalOrFloat lexer
45
46 data Sign = Positive | Negative
47
48 applySign :: Num a => Sign -> a -> a
49 applySign Positive = id
50 applySign Negative = negate
51
52 sign :: Parser Sign
53 sign = do char '-'
54 return Negative
55 <|> do char '+'
56 return Positive
57 <|> return Positive
58
59 intOrFloat :: Parser (Either Integer Double)
60 intOrFloat = do s <- sign
61 num <- naturalOrFloat
62 return (case num of
63 Right x -> Right (applySign s x)
64 Left x -> Left (applySign s x)
65 )
66
67
68 r :: Parseable a => String -> Pattern a -> IO (Pattern a)
69 r s orig = do catch (return $ p s)
70 (\err -> do putStrLn (show err)
71 return orig
72 )
73
74 parseRhythm :: Parser (Pattern a) -> String -> (Pattern a)
75 parseRhythm f input = either (const silence) id $ parse (pRhythm f') "" input
76 where f' = f
77 <|> do symbol "~" <?> "rest"
78 return silence
79
80
81 pRhythm :: Parser (Pattern a) -> GenParser Char () (Pattern a)
82 pRhythm f = do spaces
83 pSequence f
84
85 pSequence :: Parser (Pattern a) -> GenParser Char () (Pattern a)
de476a1 @yaxu Another rejig of pattern represetation
authored
86 pSequence f = do --x <-pReps
e9fb83a @yaxu more there
authored
87 ps <- many $ pPart f
de476a1 @yaxu Another rejig of pattern represetation
authored
88 --let p = Arc (cat ps) 0 1 x
89 return $ cat ps
12deabc initial version
alex authored
90
91 pPart :: Parser (Pattern a) -> Parser (Pattern a)
92 pPart f = do part <- parens (pSequence f) <|> f <|> pPoly f
93 spaces
94 return part
95
96 pPoly :: Parser (Pattern a) -> Parser (Pattern a)
97 pPoly f = do ps <- brackets (pRhythm f `sepBy` symbol ",")
98 return $ combine ps
99
100 pString :: Parser (String)
101 pString = many1 (letter <|> oneOf "0123456789" <|> char '/') <?> "string"
102
103 pVocable :: Parser (Pattern String)
104 pVocable = do v <- pString
de476a1 @yaxu Another rejig of pattern represetation
authored
105 return $ atom v
12deabc initial version
alex authored
106
107 pDouble :: Parser (Pattern Double)
108 pDouble = do nf <- intOrFloat <?> "float"
109 let f = either fromIntegral id nf
de476a1 @yaxu Another rejig of pattern represetation
authored
110 return $ atom f
12deabc initial version
alex authored
111
112 pBool :: Parser (Pattern Bool)
113 pBool = do oneOf "t1"
de476a1 @yaxu Another rejig of pattern represetation
authored
114 return $ atom True
12deabc initial version
alex authored
115 <|>
116 do oneOf "f0"
de476a1 @yaxu Another rejig of pattern represetation
authored
117 return $ atom False
12deabc initial version
alex authored
118
119 pInt :: Parser (Pattern Int)
120 pInt = do i <- natural <?> "integer"
de476a1 @yaxu Another rejig of pattern represetation
authored
121 return $ atom (fromIntegral i)
12deabc initial version
alex authored
122
e9fb83a @yaxu more there
authored
123 pRatio :: Parser (Rational)
124 pRatio = do n <- natural <?> "numerator"
125 d <- do char '/'
126 natural <?> "denominator"
127 <|>
128 do return 1
129 return $ n % d
130
131 pReps :: Parser (Rational)
132 pReps = angles (pRatio <?> "ratio")
133 <|>
134 do return (1 % 1)
12deabc initial version
alex authored
135
Something went wrong with that request. Please try again.