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

import Utils.Drasil (blank)
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, PrintingInformation)

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

-- | Generate a sample input file.
makeInputFile :: PrintingInformation -> DataDesc -> [Expr] -> Doc
makeInputFile :: PrintingInformation -> DataDesc -> [Expr] -> Doc
makeInputFile PrintingInformation
db DataDesc
dd [Expr]
sampData = [Doc] -> Doc
vcat (PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
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 :: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc :: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
_ [] (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 PrintingInformation
_ 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 PrintingInformation
db (Data
JunkData : ds :: DataDesc
ds@(Singleton DataItem
_ : DataDesc
_)) [Expr]
es = PrintingInformation -> DataDesc -> Char -> [Expr] -> [Doc]
docLine PrintingInformation
db DataDesc
ds Char
' ' [Expr]
es
convDataDesc PrintingInformation
db (Data
JunkData : ds :: DataDesc
ds@(Line LinePattern
_ Char
dl : DataDesc
_)) [Expr]
es = PrintingInformation -> DataDesc -> Char -> [Expr] -> [Doc]
docLine PrintingInformation
db DataDesc
ds Char
dl [Expr]
es
convDataDesc PrintingInformation
db (Data
JunkData : ds :: DataDesc
ds@(Lines LinePattern
_ Maybe Integer
_ Char
dl : DataDesc
_)) [Expr]
es = PrintingInformation -> DataDesc -> Char -> [Expr] -> [Doc]
docLine PrintingInformation
db DataDesc
ds Char
dl [Expr]
es
convDataDesc PrintingInformation
db (Singleton DataItem
_ : DataDesc
ds) (Expr
e:[Expr]
es) = PrintingInformation -> Expr -> Doc
eDoc PrintingInformation
db Expr
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
es
convDataDesc PrintingInformation
db (Line (Straight [DataItem]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es
  in PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl [Expr]
l Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
convDataDesc PrintingInformation
db (Line (Repeat [DataItem]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es
  in PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
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]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
convDataDesc PrintingInformation
db (Lines (Straight [DataItem]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [Expr]
es = ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl)
  ([Expr] -> [[Expr]]
orderVecs [Expr]
es)
convDataDesc PrintingInformation
db (Lines (Straight [DataItem]
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 ([DataItem] -> Int
forall a. [a] -> 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 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 (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl) [[Expr]]
vs
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered wrong-sized vectors"
convDataDesc PrintingInformation
db (Lines (Repeat [DataItem]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [Expr]
es = ([[Expr]] -> Doc) -> [[[Expr]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
  (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
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 PrintingInformation
db (Lines (Repeat [DataItem]
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 ([DataItem] -> Int
forall a. [a] -> 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 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
  (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
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]
++ PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered wrong-sized matrices"
convDataDesc PrintingInformation
db (Data
JunkData : DataDesc
ds) [Expr]
es = Doc
blank Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
es

-- helpers

-- | Helper to create a data line with the given delimeter.
dataLine :: PrintingInformation -> Delim -> [Expr] -> Doc
dataLine :: PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
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 (PrintingInformation -> Expr -> Doc
eDoc PrintingInformation
db)

-- | Helper to create document lines with a data description, delimiter, and expressions.
docLine :: PrintingInformation -> DataDesc -> Delim -> [Expr] -> [Doc]
docLine :: PrintingInformation -> DataDesc -> Char -> [Expr] -> [Doc]
docLine PrintingInformation
db DataDesc
ds Char
dl [Expr]
es = let dis :: [DataItem]
dis = Data -> [DataItem]
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)
  ((DataItem -> Doc) -> [DataItem] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\DataItem
di -> (PrintingInformation -> Sentence -> Doc
sDoc PrintingInformation
db (Sentence -> Doc) -> (DataItem -> Sentence) -> DataItem -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataItem -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase) 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]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
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 :: PrintingInformation -> Sentence -> Doc
sDoc :: PrintingInformation -> Sentence -> Doc
sDoc PrintingInformation
pinfo = PrintingInformation -> SingleLine -> Sentence -> Doc
sentenceDoc PrintingInformation
pinfo SingleLine
OneLine

-- | Creates a 'OneLine' 'Implementation'-stage 'exprDoc'.
eDoc :: PrintingInformation -> Expr -> Doc
eDoc :: PrintingInformation -> Expr -> Doc
eDoc PrintingInformation
pinfo = PrintingInformation -> SingleLine -> Expr -> Doc
exprDoc PrintingInformation
pinfo SingleLine
OneLine

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