module Language.Drasil.Code.Imperative.WriteInput (
  makeInputFile
) where 
  
import Utils.Drasil (blank)
import Database.Drasil (ChunkDB)
import Language.Drasil hiding (space)
import Language.Drasil.Code.DataDesc (DataDesc, Data(..), Delim, 
  LinePattern(..), getDataInputs, isJunk)
import Language.Drasil.Expr.Development (Expr(Matrix))
import Language.Drasil.Printers (Linearity(Linear), exprDoc, sentenceDoc, 
  unitDoc)

import Control.Lens (view)
import Data.List (intersperse, transpose)
import Text.PrettyPrint.HughesPJ (Doc, (<+>), char, empty, hcat, parens, space, 
  text, vcat)

-- | Generate a sample input file.
makeInputFile :: ChunkDB -> DataDesc -> [Expr] -> Doc
makeInputFile :: ChunkDB -> DataDesc -> [Expr] -> Doc
makeInputFile db :: ChunkDB
db dd :: DataDesc
dd sampData :: [Expr]
sampData = [Doc] -> Doc
vcat (ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
dd [Expr]
sampData)

-- | Writes a data file formatted according to the given 'DataDesc', where the data 
-- values come from the passed \['Expr'\]. 
convDataDesc :: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc :: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc _ [] (_:_) = [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Doc]) -> [Char] -> [Doc]
forall a b. (a -> b) -> a -> b
$ "makeInputFile received more inputs" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 
          " than expected, should be impossible"
convDataDesc _ ds :: DataDesc
ds [] = if (Data -> Bool) -> DataDesc -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Data -> Bool
isJunk DataDesc
ds then Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (DataDesc -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length DataDesc
ds) Doc
blank 
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error "makeInputFile received fewer inputs than expected, should be impossible"
convDataDesc db :: ChunkDB
db (JunkData : ds :: DataDesc
ds@(Singleton _ : _)) es :: [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds ' ' [Expr]
es
convDataDesc db :: ChunkDB
db (JunkData : ds :: DataDesc
ds@(Line _ dl :: Char
dl : _)) es :: [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
dl [Expr]
es
convDataDesc db :: ChunkDB
db (JunkData : ds :: DataDesc
ds@(Lines _ _ dl :: Char
dl : _)) es :: [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
dl [Expr]
es
convDataDesc db :: ChunkDB
db (Singleton _ : ds :: DataDesc
ds) (e :: Expr
e:es :: [Expr]
es) = ChunkDB -> Expr -> Doc
eDoc ChunkDB
db Expr
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
es
convDataDesc db :: ChunkDB
db (Line (Straight dis :: [DataItem]
dis) dl :: Char
dl : ds :: DataDesc
ds) es :: [Expr]
es = let 
  (l :: [Expr]
l,ls :: [Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es 
  in ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl [Expr]
l Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
convDataDesc db :: ChunkDB
db (Line (Repeat dis :: [DataItem]
dis) dl :: Char
dl : ds :: DataDesc
ds) es :: [Expr]
es = let 
  (l :: [Expr]
l,ls :: [Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es 
  in ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl ([[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr]) -> [[Expr]] -> [Expr]
forall a b. (a -> b) -> a -> b
$ [Expr] -> [[Expr]]
orderVecs [Expr]
l)
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
convDataDesc db :: ChunkDB
db (Lines (Straight _) Nothing dl :: Char
dl : _) es :: [Expr]
es = ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl) 
  ([Expr] -> [[Expr]]
orderVecs [Expr]
es)
convDataDesc db :: ChunkDB
db (Lines (Straight dis :: [DataItem]
dis) (Just n :: Integer
n) dl :: Char
dl : ds :: DataDesc
ds) es :: [Expr]
es = let
  (l :: [Expr]
l,ls :: [Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es 
  vs :: [[Expr]]
vs = [Expr] -> [[Expr]]
orderVecs [Expr]
l
  in if Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([[Expr]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Expr]]
vs) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n then ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl) [[Expr]]
vs
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error "makeInputFile encountered wrong-sized vectors"
convDataDesc db :: ChunkDB
db (Lines (Repeat _) Nothing dl :: Char
dl : _) es :: [Expr]
es = ([[Expr]] -> Doc) -> [[[Expr]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map 
  (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl ([Expr] -> Doc) -> ([[Expr]] -> [Expr]) -> [[Expr]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr])
-> ([[Expr]] -> [[Expr]]) -> [[Expr]] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
transpose) ([Expr] -> [[[Expr]]]
orderMtxs [Expr]
es)
convDataDesc db :: ChunkDB
db (Lines (Repeat dis :: [DataItem]
dis) (Just n :: Integer
n) dl :: Char
dl : ds :: DataDesc
ds) es :: [Expr]
es = let
  (l :: [Expr]
l,ls :: [Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es
  ms :: [[[Expr]]]
ms = [Expr] -> [[[Expr]]]
orderMtxs [Expr]
l
  in if Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([[[Expr]]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Expr]]]
ms) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n then ([[Expr]] -> Doc) -> [[[Expr]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
  (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl ([Expr] -> Doc) -> ([[Expr]] -> [Expr]) -> [[Expr]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr])
-> ([[Expr]] -> [[Expr]]) -> [[Expr]] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
transpose) [[[Expr]]]
ms
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error "makeInputFile encountered wrong-sized matrices"
convDataDesc db :: ChunkDB
db (JunkData : ds :: DataDesc
ds) es :: [Expr]
es = Doc
blank Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
es

-- helpers 

-- | Helper to create a data line with the given delimeter.
dataLine :: ChunkDB -> Delim -> [Expr] -> Doc
dataLine :: ChunkDB -> Char -> [Expr] -> Doc
dataLine db :: ChunkDB
db dl :: Char
dl = [Doc] -> Doc
hcat ([Doc] -> Doc) -> ([Expr] -> [Doc]) -> [Expr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
dl) ([Doc] -> [Doc]) -> ([Expr] -> [Doc]) -> [Expr] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> Expr -> Doc
eDoc ChunkDB
db)

-- | Helper to create document lines with a data description, delimiter, and expressions.
docLine :: ChunkDB -> DataDesc -> Delim -> [Expr] -> [Doc]
docLine :: ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine db :: ChunkDB
db ds :: DataDesc
ds dl :: Char
dl es :: [Expr]
es = let dis :: [DataItem]
dis = Data -> [DataItem]
getDataInputs (DataDesc -> Data
forall a. [a] -> a
head DataDesc
ds) 
  in [Char] -> Doc
text "#" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
dl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space) 
  ((DataItem -> Doc) -> [DataItem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\di :: DataItem
di -> (ChunkDB -> Sentence -> Doc
sDoc ChunkDB
db (Sentence -> Doc) -> (DataItem -> Sentence) -> DataItem -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> Sentence) -> (DataItem -> NP) -> DataItem -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting NP DataItem NP -> DataItem -> NP
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NP DataItem NP
forall c. NamedIdea c => Lens' c NP
term) DataItem
di Doc -> Doc -> Doc
<+> 
  Doc -> (UnitDefn -> Doc) -> Maybe UnitDefn -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens (Doc -> Doc) -> (UnitDefn -> Doc) -> UnitDefn -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. USymb -> Doc
uDoc (USymb -> Doc) -> (UnitDefn -> USymb) -> UnitDefn -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb) (DataItem -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit DataItem
di)) [DataItem]
dis)) 
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
es

-- | Order vectors.
orderVecs :: [Expr] -> [[Expr]]
orderVecs :: [Expr] -> [[Expr]]
orderVecs vs :: [Expr]
vs = [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
transpose ([[Expr]] -> [[Expr]]) -> [[Expr]] -> [[Expr]]
forall a b. (a -> b) -> a -> b
$ (Expr -> [Expr]) -> [Expr] -> [[Expr]]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> [Expr]
getVecList [Expr]
vs

-- | Helper to get a vector (singular 'Matrix') in list form.
getVecList :: Expr -> [Expr]
getVecList :: Expr -> [Expr]
getVecList (Matrix [l :: [Expr]
l]) = [Expr]
l
getVecList _ = [Char] -> [Expr]
forall a. HasCallStack => [Char] -> a
error "makeInputFile encountered unexpected type, expected vector"

-- | Order matricies.
orderMtxs :: [Expr] -> [[[Expr]]]
orderMtxs :: [Expr] -> [[[Expr]]]
orderMtxs ms :: [Expr]
ms = [[[Expr]]] -> [[[Expr]]]
forall a. [[a]] -> [[a]]
transpose ([[[Expr]]] -> [[[Expr]]]) -> [[[Expr]]] -> [[[Expr]]]
forall a b. (a -> b) -> a -> b
$ (Expr -> [[Expr]]) -> [Expr] -> [[[Expr]]]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> [[Expr]]
getMtxLists [Expr]
ms

-- | Helper to get a 'Matrix' in a 2D list form.
getMtxLists :: Expr -> [[Expr]]
getMtxLists :: Expr -> [[Expr]]
getMtxLists (Matrix l :: [[Expr]]
l) = [[Expr]]
l
getMtxLists _ = [Char] -> [[Expr]]
forall a. HasCallStack => [Char] -> a
error "makeInputFile encountered unexpected type, expected matrix"

-- | Creates a 'Linear' 'Implementation'-stage 'sentenceDoc'.
sDoc :: ChunkDB -> Sentence -> Doc
sDoc :: ChunkDB -> Sentence -> Doc
sDoc db :: ChunkDB
db = ChunkDB -> Stage -> Linearity -> Sentence -> Doc
sentenceDoc ChunkDB
db Stage
Implementation Linearity
Linear

-- | Creates a 'Linear' 'Implementation'-stage 'exprDoc'.
eDoc :: ChunkDB -> Expr -> Doc
eDoc :: ChunkDB -> Expr -> Doc
eDoc db :: ChunkDB
db = ChunkDB -> Stage -> Linearity -> Expr -> Doc
exprDoc ChunkDB
db Stage
Implementation Linearity
Linear

-- | Creates a 'Linear' 'unitDoc'.
uDoc :: USymb -> Doc
uDoc :: USymb -> Doc
uDoc = Linearity -> USymb -> Doc
unitDoc Linearity
Linear