module Language.Drasil.Code.Imperative.WriteInput (
  makeInputFile
) where

import Utils.Drasil (blank)
import Database.Drasil (ChunkDB)
import Language.Drasil hiding (space, Matrix)
import Language.Drasil.Code.DataDesc (DataDesc, Data(..), Delim,
  LinePattern(..), getDataInputs, isJunk)
import Language.Drasil.Expr.Development (Expr(Matrix))
import Language.Drasil.Printers (SingleLine(OneLine), 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 ChunkDB
db DataDesc
dd [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 ChunkDB
_ [] (Expr
_:[Expr]
_) = [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Doc]) -> [Char] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Char]
"makeInputFile received more inputs" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char]
" than expected, should be impossible"
convDataDesc ChunkDB
_ 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length DataDesc
ds) Doc
blank
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile received fewer inputs than expected, should be impossible"
convDataDesc ChunkDB
db (Data
JunkData : ds :: DataDesc
ds@(Singleton CodeVarChunk
_ : DataDesc
_)) [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
' ' [Expr]
es
convDataDesc ChunkDB
db (Data
JunkData : ds :: DataDesc
ds@(Line LinePattern
_ Char
dl : DataDesc
_)) [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
dl [Expr]
es
convDataDesc ChunkDB
db (Data
JunkData : ds :: DataDesc
ds@(Lines LinePattern
_ Maybe Integer
_ Char
dl : DataDesc
_)) [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
dl [Expr]
es
convDataDesc ChunkDB
db (Singleton CodeVarChunk
_ : DataDesc
ds) (Expr
e:[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 ChunkDB
db (Line (Straight [CodeVarChunk]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([CodeVarChunk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
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 ChunkDB
db (Line (Repeat [CodeVarChunk]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([CodeVarChunk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
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 ChunkDB
db (Lines (Straight [CodeVarChunk]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [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 ChunkDB
db (Lines (Straight [CodeVarChunk]
dis) (Just Integer
n) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([CodeVarChunk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
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 a. [a] -> 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 [Char]
"makeInputFile encountered wrong-sized vectors"
convDataDesc ChunkDB
db (Lines (Repeat [CodeVarChunk]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [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 ChunkDB
db (Lines (Repeat [CodeVarChunk]
dis) (Just Integer
n) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([CodeVarChunk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
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 a. [a] -> 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 [Char]
"makeInputFile encountered wrong-sized matrices"
convDataDesc ChunkDB
db (Data
JunkData : DataDesc
ds) [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 ChunkDB
db 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 ChunkDB
db DataDesc
ds Char
dl [Expr]
es = let dis :: [CodeVarChunk]
dis = Data -> [CodeVarChunk]
getDataInputs (DataDesc -> Data
forall a. HasCallStack => [a] -> a
head DataDesc
ds)
  in [Char] -> Doc
text [Char]
"#" 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)
  ((CodeVarChunk -> Doc) -> [CodeVarChunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\CodeVarChunk
di -> (ChunkDB -> Sentence -> Doc
sDoc ChunkDB
db (Sentence -> Doc)
-> (CodeVarChunk -> Sentence) -> CodeVarChunk -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> Sentence)
-> (CodeVarChunk -> NP) -> CodeVarChunk -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting NP CodeVarChunk NP -> CodeVarChunk -> NP
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NP CodeVarChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' CodeVarChunk NP
term) CodeVarChunk
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) (CodeVarChunk -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit CodeVarChunk
di)) [CodeVarChunk]
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 [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 [[Expr]
l]) = [Expr]
l
getVecList Expr
_ = [Char] -> [Expr]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered unexpected type, expected vector"

-- | Order matricies.
orderMtxs :: [Expr] -> [[[Expr]]]
orderMtxs :: [Expr] -> [[[Expr]]]
orderMtxs [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 [[Expr]]
l) = [[Expr]]
l
getMtxLists Expr
_ = [Char] -> [[Expr]]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered unexpected type, expected matrix"

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

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

-- | Creates a 'OneLine' 'unitDoc'.
uDoc :: USymb -> Doc
uDoc :: USymb -> Doc
uDoc = SingleLine -> USymb -> Doc
unitDoc SingleLine
OneLine