module Data.Matrix.AsXYZ.ParseXYZ (
ReadNum(..),
equivalentPositions,
transformPpABC,
transformQqXYZ,
ratio,
floating,
integral,
sign,
minus,
overlap,
elementBody,
) where
import Control.Monad
import Data.Char
import Data.Maybe
import Data.List
import Text.ParserCombinators.Parsec
import Data.Ratio
import Data.Ratio.Slash
import Data.Ratio.ParseFloat (readFloatingPoint)
import Data.Matrix (fromList,fromLists,Matrix(..),joinBlocks,(<->))
import Data.Matrix.AsXYZ.Common (Var(..),Val(..))
equivalentPositions :: Num a =>
ReadNum a
-> CharParser () [[a]]
equivalentPositions = components xyz
transformPpABC :: Num a => ReadNum a -> CharParser () [[a]]
transformPpABC = components abc
transformQqXYZ :: Num a => ReadNum a -> CharParser () [[a]]
transformQqXYZ = components xyz
ratio :: Integral a => ReadNum (Ratio a)
ratio (I s) = Right $ getRatio . read $ s
ratio (R s) = Right $ getRatio . read $ s
ratio (F s) = Right $ readFloatingPoint s
integral :: Integral a => ReadNum a
integral (I s) = Right $ fromIntegral (read s :: Integer)
integral (R s) = Left $ "cannot convert to integer from " ++ s ++ "."
integral (F s) = Left $ "cannot convert to integer from " ++ s ++ "."
floating :: Floating a => ReadNum a
floating v = fromRational <$> ratio v
type Value = Val String
v c = f $ toLower <$> c
where
f (Just 'x') = X
f (Just 'a') = X
f (Just 'y') = Y
f (Just 'b') = Y
f (Just 'z') = Z
f (Just 'c') = Z
f Nothing = W
sign :: CharParser () Char
sign = oneOf "-+"
zero :: CharParser () String
zero = do
char '0'
return "0"
num :: CharParser () String
num = do
x <- oneOf "123456789"
xs <- many digit
return $ x : xs
int :: CharParser () String
int = zero <|> num
integer :: CharParser () Value
integer = do
i <- int
return (I i)
float :: CharParser () Value
float = do
i <- option "" int
char '.'
f <- many digit
return (F $ i ++ "." ++ f )
fract :: CharParser () Value
fract = do
n <- many1 digit
option () spaces
char '/'
option () spaces
d <- many1 digit
return (R $ n ++ "/" ++ d)
number' :: CharParser () Value
number'
= try fract
<|> try float
<|> integer
type ReadNum b = Value -> Either String b
number :: ReadNum b -> CharParser () b
number numRead = do
n <- number'
case numRead n of
Left s -> fail s
Right nn -> return nn
elementBody :: CharParser () Char -> ReadNum a -> CharParser () (Maybe a, Maybe Char)
elementBody var conv = do
n <- optionMaybe (number conv)
option () spaces
v <- optionMaybe var
option () spaces
guard (isJust n || isJust v)
return (n,v)
minus :: Num a => Maybe Char -> (a -> a)
minus (Just '-') = negate
minus (Just '+') = id
minus Nothing = id
one :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)
one var numRead = do
s <- optionMaybe sign
option () spaces
(n,l) <- elementBody var numRead
return $ v l . minus s . fromMaybe 1 $ n
other :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)
other var numRead = do
s <- sign
option () spaces
(n,l) <- elementBody var numRead
return $ v l . minus (Just s) . fromMaybe 1 $ n
overlap :: Eq a => [a] -> Bool
overlap n = (length . nub) n /= length n
constructRow :: Num a => [Var a] -> [a]
constructRow = map (fromMaybe 0 . listToMaybe . catMaybes) . transpose . map toArray
where
toArray (X n) = [Just n,Nothing,Nothing,Nothing]
toArray (Y n) = [Nothing,Just n,Nothing,Nothing]
toArray (Z n) = [Nothing,Nothing,Just n,Nothing]
toArray (W n) = [Nothing,Nothing,Nothing,Just n]
component :: Num b => CharParser () Char -> ReadNum b -> CharParser () [b]
component var numRead = do
option () spaces
x <- one var numRead
xs <- many (other var numRead)
option () spaces
let mm = x : xs
if overlap (map void mm)
then
fail "overlaps var type"
else
return (constructRow mm)
components :: Num a => CharParser () Char -> ReadNum a -> CharParser () [[a]]
components var conv = do
a <- component var conv
char ','
b <- component var conv
char ','
c <- component var conv
return [a,b,c]
xyz :: CharParser () Char
xyz = oneOf "xyzXYZ"
abc :: CharParser () Char
abc = oneOf "abcABC"