{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Internal.Quasi.Matrix.Quasi (matrix, vector) where
import Internal.Matrix
import qualified Internal.Quasi.Matrix.Parser as Parser
import qualified Internal.Quasi.Parser as Parser
import Internal.Quasi.Quasi
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
matrix :: QuasiQuoter
matrix :: QuasiQuoter
matrix =
QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = Parser [[Exp]] -> String -> Q Exp
expr Parser [[Exp]]
Parser.matrix,
quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. String -> a
notDefined "Pattern",
quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. String -> a
notDefined "Type",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. String -> a
notDefined "Declaration"
}
where
notDefined :: String -> a
notDefined = String -> String -> a
forall a. String -> String -> a
isNotDefinedAs "matrix"
vector :: QuasiQuoter
vector :: QuasiQuoter
vector =
QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
vectorExpr,
quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. String -> a
notDefined "Pattern",
quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. String -> a
notDefined "Type",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. String -> a
notDefined "Declaration"
}
where
notDefined :: String -> a
notDefined = String -> String -> a
forall a. String -> String -> a
isNotDefinedAs "vector"
vectorExpr :: String -> Q Exp
vectorExpr :: String -> Q Exp
vectorExpr source :: String
source = Exp -> Exp
f (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [[Exp]] -> String -> Q Exp
expr Parser [[Exp]]
Parser.vector String
source
where
f :: Exp -> Exp
f = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'toVector)
expr :: Parser.Parser [[Exp]] -> String -> Q Exp
expr :: Parser [[Exp]] -> String -> Q Exp
expr parser :: Parser [[Exp]]
parser source :: String
source = do
let (matrix :: [[Exp]]
matrix, (m :: Integer
m, n :: Integer
n)) = Either [String] ([[Exp]], (Integer, Integer))
-> ([[Exp]], (Integer, Integer))
forall a. Either [String] a -> a
unwrap (Either [String] ([[Exp]], (Integer, Integer))
-> ([[Exp]], (Integer, Integer)))
-> Either [String] ([[Exp]], (Integer, Integer))
-> ([[Exp]], (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ String
-> Parser [[Exp]] -> Either [String] ([[Exp]], (Integer, Integer))
forall a.
String
-> Parser [[a]] -> Either [String] ([[a]], (Integer, Integer))
parse String
source Parser [[Exp]]
parser
let sizeType :: Integer -> Type
sizeType = TyLit -> Type
LitT (TyLit -> Type) -> (Integer -> TyLit) -> Integer -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> TyLit
NumTyLit
let constructor :: Exp
constructor = (Exp -> Type -> Exp) -> Exp -> [Type] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Exp -> Type -> Exp
AppTypeE (Name -> Exp
ConE 'Matrix) [Integer -> Type
sizeType Integer
m, Integer -> Type
sizeType Integer
n, Type
WildCardT]
let size :: Exp
size = [Exp] -> Exp
TupE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Integer -> Exp) -> [Integer] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Lit -> Exp
LitE (Lit -> Exp) -> (Integer -> Lit) -> Integer -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL) [Integer
m, Integer
n]
let value :: Exp
value = [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ ([Exp] -> Exp) -> [[Exp]] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Exp
ListE ([[Exp]] -> [Exp]) -> [[Exp]] -> [Exp]
forall a b. (a -> b) -> a -> b
$ [[Exp]]
matrix
Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Exp -> Exp -> Exp
AppE Exp
constructor [Exp
size, Exp
value]
parse :: String -> Parser.Parser [[a]] -> Either [String] ([[a]], (Integer, Integer))
parse :: String
-> Parser [[a]] -> Either [String] ([[a]], (Integer, Integer))
parse source :: String
source parser :: Parser [[a]]
parser = do
[[a]]
matrix <- Parser [[a]] -> String -> String -> Either [String] [[a]]
forall a. Parser a -> String -> String -> Either [String] a
Parser.parse Parser [[a]]
parser "QLinear" String
source
(Integer, Integer)
size <- [[a]] -> Either [String] (Integer, Integer)
forall a. [[a]] -> Either [String] (Integer, Integer)
checkSize [[a]]
matrix
([[a]], (Integer, Integer))
-> Either [String] ([[a]], (Integer, Integer))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[a]]
matrix, (Integer, Integer)
size)
checkSize :: [[a]] -> Either [String] (Integer, Integer)
checkSize :: [[a]] -> Either [String] (Integer, Integer)
checkSize [] = [String] -> Either [String] (Integer, Integer)
forall a b. a -> Either a b
Left ["Matrix cannot be empty"]
checkSize matrix :: [[a]]
matrix =
let lines :: [Int]
lines@(l :: Int
l : ls :: [Int]
ls) = ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
matrix
in if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l) [Int]
ls
then (Integer, Integer) -> Either [String] (Integer, Integer)
forall a b. b -> Either a b
Right (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
matrix, Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
else [String] -> Either [String] (Integer, Integer)
forall a b. a -> Either a b
Left ["All lines must be the same length"]
toVector :: Matrix n 1 a -> Vector n a
toVector :: Matrix n 1 a -> Matrix n 1 a
toVector = Matrix n 1 a -> Matrix n 1 a
forall a. a -> a
id