{-# 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

-- | Macro constructor for 'QLinear.Matrix.Matrix'
--
-- >>> [matrix| 1 2; 3 4 |]
-- [1,2]
-- [3,4]
-- >>> :t [matrix| 1 2; 3 4|]
-- [matrix| 1 2; 3 4|] :: Num a => Matrix 2 2 a
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"

-- | Macro constructor for 'QLinear.Matrix.Vector'.
--
-- >>> [vector| 1 2 3 4 |]
-- [1]
-- [2]
-- [3]
-- [4]
-- >>> :t [vector| 1 2 3 4 |]
-- [vector| 1 2 3 4 |] :: Num a => Vector 4 a
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