-- | Source code reader for type dependency graphs of all Drasil types.
module Drasil.Meta.Analysis.SourceCodeReaderT (extractEntryData, EntryData(..), DataDeclRecord(..),
 DataDeclConstruct(..), NewtypeDecl(..), TypeDecl(..), DataTypeDeclaration(..)) where

import Data.List ((\\), elemIndex, findIndex, isInfixOf, isPrefixOf,
  isSuffixOf, nub)
import System.IO (readFile')
import System.Directory (setCurrentDirectory)
import qualified Data.Text as T
import qualified Data.List.Split as L
import Data.Maybe (fromJust)
import Data.Char (isUpper)

import Drasil.Meta.Analysis.DirectoryController as DC (FileName)

import Data.Containers.ListUtils (nubOrd)

-- Synonyms for clarity
type DataName = String
type NewtypeName = String
type TypeName = String

------------
-- Main function and datatypes for creating a .dot graph of the type dependencies in Drasil
-----------

-- purposefully use different type names even though they will end up in the same form (for now)
data DataDeclRecord = DDR { DataDeclRecord -> String
ddrName :: DataName                       -- this can actually be any kind of type, but use DataName for clarity (same with below)
                          , DataDeclRecord -> [String]
ddrContent :: [DataName]} deriving (Int -> DataDeclRecord -> ShowS
[DataDeclRecord] -> ShowS
DataDeclRecord -> String
(Int -> DataDeclRecord -> ShowS)
-> (DataDeclRecord -> String)
-> ([DataDeclRecord] -> ShowS)
-> Show DataDeclRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataDeclRecord -> ShowS
showsPrec :: Int -> DataDeclRecord -> ShowS
$cshow :: DataDeclRecord -> String
show :: DataDeclRecord -> String
$cshowList :: [DataDeclRecord] -> ShowS
showList :: [DataDeclRecord] -> ShowS
Show) -- same with this
data DataDeclConstruct = DDC { DataDeclConstruct -> String
ddcName :: DataName
                          , DataDeclConstruct -> [String]
ddcContent :: [DataName]} deriving (Int -> DataDeclConstruct -> ShowS
[DataDeclConstruct] -> ShowS
DataDeclConstruct -> String
(Int -> DataDeclConstruct -> ShowS)
-> (DataDeclConstruct -> String)
-> ([DataDeclConstruct] -> ShowS)
-> Show DataDeclConstruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataDeclConstruct -> ShowS
showsPrec :: Int -> DataDeclConstruct -> ShowS
$cshow :: DataDeclConstruct -> String
show :: DataDeclConstruct -> String
$cshowList :: [DataDeclConstruct] -> ShowS
showList :: [DataDeclConstruct] -> ShowS
Show)
data NewtypeDecl = NTD { NewtypeDecl -> String
ntdName :: NewtypeName
                          , NewtypeDecl -> [String]
ntdContent :: [NewtypeName]} deriving (Int -> NewtypeDecl -> ShowS
[NewtypeDecl] -> ShowS
NewtypeDecl -> String
(Int -> NewtypeDecl -> ShowS)
-> (NewtypeDecl -> String)
-> ([NewtypeDecl] -> ShowS)
-> Show NewtypeDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewtypeDecl -> ShowS
showsPrec :: Int -> NewtypeDecl -> ShowS
$cshow :: NewtypeDecl -> String
show :: NewtypeDecl -> String
$cshowList :: [NewtypeDecl] -> ShowS
showList :: [NewtypeDecl] -> ShowS
Show)
data TypeDecl = TD { TypeDecl -> String
tdName :: TypeName
                    , TypeDecl -> [String]
tdContent :: [TypeName]} deriving (Int -> TypeDecl -> ShowS
[TypeDecl] -> ShowS
TypeDecl -> String
(Int -> TypeDecl -> ShowS)
-> (TypeDecl -> String) -> ([TypeDecl] -> ShowS) -> Show TypeDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeDecl -> ShowS
showsPrec :: Int -> TypeDecl -> ShowS
$cshow :: TypeDecl -> String
show :: TypeDecl -> String
$cshowList :: [TypeDecl] -> ShowS
showList :: [TypeDecl] -> ShowS
Show)

-- The above types all have a name and other types they build upon (contents).
class DataTypeDeclaration a where
  getTypeName :: a -> String
  getContents :: a -> [String]

instance DataTypeDeclaration DataDeclRecord where
  getTypeName :: DataDeclRecord -> String
getTypeName = DataDeclRecord -> String
ddrName
  getContents :: DataDeclRecord -> [String]
getContents = DataDeclRecord -> [String]
ddrContent
instance DataTypeDeclaration DataDeclConstruct where
  getTypeName :: DataDeclConstruct -> String
getTypeName = DataDeclConstruct -> String
ddcName
  getContents :: DataDeclConstruct -> [String]
getContents = DataDeclConstruct -> [String]
ddcContent
instance DataTypeDeclaration NewtypeDecl where
  getTypeName :: NewtypeDecl -> String
getTypeName = NewtypeDecl -> String
ntdName
  getContents :: NewtypeDecl -> [String]
getContents = NewtypeDecl -> [String]
ntdContent
instance DataTypeDeclaration TypeDecl where
  getTypeName :: TypeDecl -> String
getTypeName = TypeDecl -> String
tdName
  getContents :: TypeDecl -> [String]
getContents = TypeDecl -> [String]
tdContent

-- new EntryData data type with strict fields to enforce strict file reading
data EntryData = EntryData { EntryData -> [DataDeclRecord]
dRNs :: ![DataDeclRecord]    -- Record datatypes will be shown differently on a dot graph
                           , EntryData -> [DataDeclConstruct]
dCNs :: ![DataDeclConstruct] -- compared to these datatypes that use constructors.
                           , EntryData -> [NewtypeDecl]
ntNs :: ![NewtypeDecl]       -- Newtypes will be recorded as records (usually only wrap one other type)
                           , EntryData -> [TypeDecl]
tNs :: ![TypeDecl]} deriving (Int -> EntryData -> ShowS
[EntryData] -> ShowS
EntryData -> String
(Int -> EntryData -> ShowS)
-> (EntryData -> String)
-> ([EntryData] -> ShowS)
-> Show EntryData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryData -> ShowS
showsPrec :: Int -> EntryData -> ShowS
$cshow :: EntryData -> String
show :: EntryData -> String
$cshowList :: [EntryData] -> ShowS
showList :: [EntryData] -> ShowS
Show) -- Types are usually synonyms of other types, so act like Record datatypes but in a different colour.

-- extracts data, newtype and class names + instances (new data-oriented format)
extractEntryData :: DC.FileName -> FilePath -> IO EntryData
extractEntryData :: String -> String -> IO EntryData
extractEntryData String
fileName String
filePath = do
  String -> IO ()
setCurrentDirectory String
filePath
  String
scriptFile <- String -> IO String
readFile' String
fileName

      -- general light cleanup of the files before sorting by datatype
  let scriptFileLines :: [String]
scriptFileLines = String -> [String]
scriptFilter String
scriptFile
      -- organize the data from the script file into their respective data Decl formats
      dataDeclRec :: [DataDeclRecord]
dataDeclRec =  [String] -> [DataDeclRecord]
formatDataRec [String]
scriptFileLines
      dataDeclConst :: [DataDeclConstruct]
dataDeclConst = [String] -> [DataDeclConstruct]
formatDataCon [String]
scriptFileLines
      newtypeDecl :: [NewtypeDecl]
newtypeDecl = [String] -> [NewtypeDecl]
formatNewtype [String]
scriptFileLines
      typeDecl :: [TypeDecl]
typeDecl = [String] -> [TypeDecl]
formatType [String]
scriptFileLines

  -- returns all types within a file
  EntryData -> IO EntryData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntryData {dRNs :: [DataDeclRecord]
dRNs=[DataDeclRecord]
dataDeclRec,dCNs :: [DataDeclConstruct]
dCNs=[DataDeclConstruct]
dataDeclConst,ntNs :: [NewtypeDecl]
ntNs=[NewtypeDecl]
newtypeDecl,tNs :: [TypeDecl]
tNs=[TypeDecl]
typeDecl}

---TODO: use map/filter/fold for most of these, I just need to visualize what is happening for now.

--------
-- Initial Filters (In order of use)
-------

-- combine all initial filters (except for removing in-line comments, which is done later)
scriptFilter :: String -> [String]
scriptFilter :: String -> [String]
scriptFilter = [String] -> [String]
removeDeriving ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
removeNewlineGuard ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
removeNewlineBrace ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
removeNewlineEqual ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterEmptyS ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterMultilineComments ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterComments ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- get rid of lines that start with a comment.
filterComments :: [String] -> [String]
filterComments :: [String] -> [String]
filterComments [String]
ls = [String]
ls [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"--") [String]
ls

-- gets rid of lines that start or end with a multiline comment
filterMultilineComments :: [String] -> [String]
filterMultilineComments :: [String] -> [String]
filterMultilineComments [String]
ls = [String]
ls [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
l -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"{-" String
l Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
"-}" String
l) [String]
ls

-- get rid of lines with nothing in them.
filterEmptyS :: [String] -> [String]
filterEmptyS :: [String] -> [String]
filterEmptyS = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"")

-- for those few cases of data declarations that start the actual data declaration on a new line after the "=" sign.
removeNewlineEqual :: [String] -> [String]
removeNewlineEqual :: [String] -> [String]
removeNewlineEqual = (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline String -> Bool
prefixCheck (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True)
  where
    prefixCheck :: String -> Bool
prefixCheck String
l = (String
"data " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l Bool -> Bool -> Bool
|| String
"type " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l Bool -> Bool -> Bool
|| String
"newtype " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l) Bool -> Bool -> Bool
&& String
"=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
l

-- for those few cases of data declarations that are record types where the "{" is on a newline.
removeNewlineBrace :: [String] -> [String]
removeNewlineBrace :: [String] -> [String]
removeNewlineBrace = (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline String -> Bool
prefixCheck (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"{")
  where
    prefixCheck :: String -> Bool
prefixCheck String
l = String
"data " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l Bool -> Bool -> Bool
|| String
"newtype " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l

-- for those few cases of data declarations that use constructors with guards on a newline.
removeNewlineGuard :: [String] -> [String]
removeNewlineGuard :: [String] -> [String]
removeNewlineGuard = (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"|")

-- Gets rid of automatically derived instances since we only care about type dependencies.
removeDeriving :: [String] -> [String]
-- FIXME: we use `"deriving" ++ " "` so that this line doesn't crash while trying to analyze itself.
removeDeriving :: [String] -> [String]
removeDeriving = (String -> Bool) -> ShowS -> [String] -> [String]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
mapIf (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf (String
"deriving" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ")) (ShowS -> [String] -> [String]) -> ShowS -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ \String
l -> [String] -> String
unwords (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
"deriving" (String -> [String]
words String
l))) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
l )

-- Removes comments that are a part of datatype lines (drops everything after the comment symbol).
removeComments :: [String] -> [String]
removeComments :: [String] -> [String]
removeComments = (String -> Bool) -> ShowS -> [String] -> [String]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
mapIf (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"--") (ShowS -> [String] -> [String]) -> ShowS -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ \String
l -> [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex  (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"--") ([String] -> Maybe Int) -> [String] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
l) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
l

-- helper map functions to reduce code clutter --

-- map a function to a list if a predicate passes, otherwise, just keep element the same.
mapIf :: (a -> Bool) -> (a -> a) -> [a] -> [a]
mapIf :: forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
mapIf a -> Bool
p a -> a
f = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
p a
x then a -> a
f a
x else a
x)

-- helper to remove newlines if the contents pass a predicate, otherwise just skip over the element.
-- Maps over two elements at a time. First predicate is for first line, second is for the second line.
filterNewline :: (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline :: (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline String -> Bool
_ String -> Bool
_ [] = []
filterNewline String -> Bool
p1 String -> Bool
p2 (String
l1:String
l2:[String]
ls) = if String -> Bool
p1 String
l1 Bool -> Bool -> Bool
&& String -> Bool
p2 String
l2 then (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline String -> Bool
p1 String -> Bool
p2 ((String
l1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l2)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls) else String
l1 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline String -> Bool
p1 String -> Bool
p2 (String
l2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls)
filterNewline String -> Bool
_ String -> Bool
_ [String]
ls = [String]
ls

-------------------------------
-- Main formatting functions (combine many filtering and sorting functions for cleaner code)
-- Takes in the raw file data, formats it into nice usable strings, and then sorts them into their respective type declarations
------------------------------

-- combine record data sorting & cleanup functions for cleaner code in extractEntryData
formatDataRec :: [String] -> [DataDeclRecord]
                -- sorting functions                                                           -- cleanup functions
formatDataRec :: [String] -> [DataDeclRecord]
formatDataRec = [(String, [String])] -> [DataDeclRecord]
getDataContainedRec ([(String, [String])] -> [DataDeclRecord])
-> ([String] -> [(String, [String])])
-> [String]
-> [DataDeclRecord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(String, [String])]
sortDataRec ([String] -> [(String, [String])])
-> ([String] -> [String]) -> [String] -> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterEmptyS ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"}\n" (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
removeNewlineComma ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [String] -> [String]
useConstructFormRec Bool
False ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
removeComments ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
isDataRec

-- combine constructor data sorting & cleanup functions for cleaner code in extractEntryData
formatDataCon :: [String] -> [DataDeclConstruct]
                -- sorting functions                    -- cleanup functions
formatDataCon :: [String] -> [DataDeclConstruct]
formatDataCon = [(String, [String])] -> [DataDeclConstruct]
getDataContainedConst ([(String, [String])] -> [DataDeclConstruct])
-> ([String] -> [(String, [String])])
-> [String]
-> [DataDeclConstruct]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(String, [String])]
sortDataConst ([String] -> [(String, [String])])
-> ([String] -> [String]) -> [String] -> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
removeComments ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
isDataConst ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
useEqForm ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
useGuardForm

-- combine newtype sorting & cleanup functions for cleaner code in extractEntryData
formatNewtype :: [String] -> [NewtypeDecl]
                -- sorting functions
formatNewtype :: [String] -> [NewtypeDecl]
formatNewtype [String]
sfLines = [(String, [String])] -> [NewtypeDecl]
getNewtypes ([(String, [String])] -> [NewtypeDecl])
-> [(String, [String])] -> [NewtypeDecl]
forall a b. (a -> b) -> a -> b
$ [String] -> [(String, [String])]
sortNewtypesR [String]
newtypeRec [(String, [String])]
-> [(String, [String])] -> [(String, [String])]
forall a. [a] -> [a] -> [a]
++ [String] -> [(String, [String])]
sortNewtypesC [String]
newtypeConst
  where
    -- cleanup functions
    newtypeRec :: [String]
newtypeRec = [String] -> [String]
removeComments ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
isNewtypeRec [String]
sfLines
    newtypeConst :: [String]
newtypeConst = [String] -> [String]
removeComments ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
isNewtypeConst [String]
sfLines

-- combine type sorting & cleanup functions for cleaner code in extractEntryData
formatType :: [String] -> [TypeDecl]
             -- sorting functions   -- cleanup functions
formatType :: [String] -> [TypeDecl]
formatType = [(String, [String])] -> [TypeDecl]
getTypes ([(String, [String])] -> [TypeDecl])
-> ([String] -> [(String, [String])]) -> [String] -> [TypeDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(String, [String])]
sortTypes ([String] -> [(String, [String])])
-> ([String] -> [String]) -> [String] -> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
removeComments ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
isType

-----------------
-- Sorting and filtering for functions that use @data@ syntax (for record types)
----------------

-- Attach booleans to see if a line is a part of a record data type declaration.
-- This is needed to organize and arrage data types.
isDataRec :: [String] -> [String]
isDataRec :: [String] -> [String]
isDataRec [String]
dataRecs = [String] -> Bool -> [String]
isDataRecAux [String]
dataRecs Bool
False
  where
    isDataRecAux :: [String] -> Bool -> [String]
isDataRecAux [] Bool
_ = []
    isDataRecAux (String
l:[String]
ls) Bool
dtStill
      | String
"data " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l Bool -> Bool -> Bool
&& String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l Bool -> Bool -> Bool
&& String
"}" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l = String
lString -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> Bool -> [String]
isDataRecAux [String]
ls Bool
False -- if a line starts with "data " and contains "{" and "}", it is the start and end of a record datatype.
      | String
"data " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l Bool -> Bool -> Bool
&& String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l = String
lString -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> Bool -> [String]
isDataRecAux [String]
ls Bool
True -- if a line starts with "data " and contains "{", it is the start of a record datatype.
      | Bool
dtStill Bool -> Bool -> Bool
&& String
"}" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l = String
lString -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> Bool -> [String]
isDataRecAux [String]
ls Bool
False               -- if a line is still part of record datatype and we see "}", the datatype declaration has ended.
      | Bool
dtStill = String
lString -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> Bool -> [String]
isDataRecAux [String]
ls Bool
True                                    -- if a line is still part of record datatype and none of the above happens, keep going with the datatype.
      | Bool
otherwise = [String] -> Bool -> [String]
isDataRecAux [String]
ls Bool
False                                    -- otherwise, it is not a datatype and keep going as if the next line is not a datatype.
    -- Trying fold style, gave me different .dot graphs so probably is not right
    {-output = map fst $ filter snd $ zip dataRecs doit
    doit = foldl (\x y -> ((++) x (someFunc (myHead (reverse x)) y))) [] dataRecs
    someFunc :: Bool -> String -> [Bool]
    someFunc dtStill l
      | "data " `isPrefixOf` l && "{" `isInfixOf` l && "}" `isInfixOf` l = [False]
      | "data " `isPrefixOf` l && "{" `isInfixOf` l = [True]
      | dtStill && "}" `isInfixOf` l = [False]
      | dtStill = [True]
      | otherwise = [False]
    myHead [] = False
    myHead (x:xs) = x-}

-- Record types may be defined in the form:
-- data Type where
--    Constructor :: (ClassConstraint a) => { record1 :: Type1
--        , record2 = [a]
--        , record3 = Type3
--        } -> Type
-- This is used in the CodeSpec and System types.
useConstructFormRec :: Bool -> [String]  -> [String]
useConstructFormRec :: Bool -> [String] -> [String]
useConstructFormRec Bool
_ [] = []
useConstructFormRec Bool
isSameRec (String
l1:String
l2:[String]
ls)
  | String
"data " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l1 Bool -> Bool -> Bool
&& String
"where " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l1 = Bool -> [String] -> [String]
useConstructFormRec Bool
True ((String
l1Construct String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l2) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ls)
  | String
"}" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l2 Bool -> Bool -> Bool
&& String
"->" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l2 = Bool -> [String] -> [String]
useConstructFormRec Bool
False ((String
l1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ls) -- may need to be changed to account for other possible variance in type declaratios, but for now it should work
  | Bool
isSameRec = Bool -> [String] -> [String]
useConstructFormRec Bool
True ((String
l1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l2)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls)
  | Bool
otherwise = String
l1 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [String] -> [String]
useConstructFormRec Bool
False (String
l2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls)
  where
      l1Construct :: String
l1Construct
        | String
"=>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l1 = Text -> String
T.unpack (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"where") (String -> Text
T.pack String
"=") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust ((String -> Bool) -> [String] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex  (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"::") (String -> [String]
words String
l1))) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
l1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {" --has a class constraint, but we can just ignore that for now
        | Bool
otherwise = Text -> String
T.unpack (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"where") (String -> Text
T.pack String
"=") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
l1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {" -- no class constraint in data type
useConstructFormRec Bool
_ [String]
ls = [String]
ls

-- Instead of separating records by newline (which are not guarenteed),
-- use commas (which will always be there for a record with more than one field).
removeNewlineComma :: [String] -> [String]
removeNewlineComma :: [String] -> [String]
removeNewlineComma = (String -> Bool) -> (String -> Bool) -> [String] -> [String]
filterNewline (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
",")

-- filter through records of the form rec :: Type1 -> f Type2. Only accepts the first type though, so this will eventually need to be changed
filterFuncForm :: String -> String
filterFuncForm :: ShowS
filterFuncForm String
l
  | String
"->" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Bool
isUpper (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. HasCallStack => [a] -> a
head) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
l
  | Bool
otherwise = String
l

-- Take a list of data declarations for records and get the name of the datatype itself and all dependencies of that datatype.
sortDataRec :: [String] -> [(String, [String])]
sortDataRec :: [String] -> [(String, [String])]
sortDataRec = (String -> (String, [String])) -> [String] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> ([String] -> String
forall a. HasCallStack => [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l, String -> [String]
typeDependencies String
l))
  where
    typeContents :: String -> [String]
typeContents String
l = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"=" (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
l String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"data "
    typeDependencies :: String -> [String]
typeDependencies String
l = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
filterFuncForm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
stripWS) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"::") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"," (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l

-- Record a datatype and its dependencies. For record types using the @data@ declaration syntax.
getDataContainedRec :: [(String, [String])] -> [DataDeclRecord]
getDataContainedRec :: [(String, [String])] -> [DataDeclRecord]
getDataContainedRec = ((String, [String]) -> DataDeclRecord)
-> [(String, [String])] -> [DataDeclRecord]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, [String])
l -> DDR {ddrName :: String
ddrName = ShowS
filterName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> String
forall a b. (a, b) -> a
fst (String, [String])
l, ddrContent :: [String]
ddrContent = [String] -> [String]
filterContents ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> [String]
forall a b. (a, b) -> b
snd (String, [String])
l})

-----------------
-- Sorting and filtering for functions that use @data@ syntax (for non-record types)
----------------

-- Some datatypes use a style similar to defining functions. This will change it over to constructors for use in other functions.
useGuardForm :: [String] -> [String]
useGuardForm :: [String] -> [String]
useGuardForm [] = []
useGuardForm (String
l1:String
l2:[String]
ls) = if String
"::" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
l2 then [String] -> [String]
useGuardForm ((String
l1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l2Guard) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ls) else String
l1String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
useGuardForm (String
l2String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls)
    where l2Guard :: String
l2Guard = String
" |" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"::") Text
forall a. Monoid a => a
mempty (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"->") Text
forall a. Monoid a => a
mempty (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
l2)
useGuardForm [String]
ls = [String]
ls

-- Some datatypes may be defined using the @where@ syntax, so this converts them to use @=@.
useEqForm :: String -> String
useEqForm :: ShowS
useEqForm = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"where") (String -> Text
T.pack String
"=") (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- For filtering out data types that are records.
isDataConst :: [String] -> [String]
isDataConst :: [String] -> [String]
isDataConst = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
dt -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"data " String
dt Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
dt))

-- Helper that takes a list of datatype declarations (not record type) and sorts them so that a list of the datatype name and the datatype constructor values is made.
sortDataConst :: [String] -> [(String, [String])]
sortDataConst :: [String] -> [(String, [String])]
sortDataConst = (String -> (String, [String])) -> [String] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> ([String] -> String
forall a. HasCallStack => [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l, String -> [String]
typeDependencies String
l))
  where
    typeContents :: String -> [String]
typeContents String
l = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOneOf String
"|=" (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
l String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"data "
    typeDependencies :: String -> [String]
typeDependencies String
l = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l

-- Record a datatype and its dependencies. For non-record types using the @data@ declaration syntax.
getDataContainedConst :: [(String, [String])] -> [DataDeclConstruct]
getDataContainedConst :: [(String, [String])] -> [DataDeclConstruct]
getDataContainedConst = ((String, [String]) -> DataDeclConstruct)
-> [(String, [String])] -> [DataDeclConstruct]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, [String])
l -> DDC {ddcName :: String
ddcName = ShowS
filterName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> String
forall a b. (a, b) -> a
fst (String, [String])
l, ddcContent :: [String]
ddcContent = [String] -> [String]
filterContents ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> [String]
forall a b. (a, b) -> b
snd (String, [String])
l})

-----------------
-- Sorting and filtering for functions that use @newtype@ syntax
----------------

-- Newtypes can be defined similar to records. Only includes those record-style declarations.
isNewtypeRec :: [String] -> [String]
isNewtypeRec :: [String] -> [String]
isNewtypeRec = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
x Bool -> Bool -> Bool
&& String
"newtype " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x)

-- Newtypes are often defined using constructors (they don't use @{@).
isNewtypeConst :: [String] -> [String]
isNewtypeConst :: [String] -> [String]
isNewtypeConst = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> Bool -> Bool
not (String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
x) Bool -> Bool -> Bool
&& String
"newtype " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x)

-- Sorts a datatype and its dependencies. For record-style @newtype@ declaration syntax.
sortNewtypesR :: [String] -> [(String, [String])]
sortNewtypesR :: [String] -> [(String, [String])]
sortNewtypesR = (String -> (String, [String])) -> [String] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> ([String] -> String
forall a. HasCallStack => [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l, String -> [String]
typeDependencies String
l))
  where typeContents :: String -> [String]
typeContents String
l = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"=" (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
l String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"newtype "
        typeDependencies :: String -> [String]
typeDependencies String
l = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"::") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"," (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l

-- Sorts a datatype and its dependencies. For constructor style @newtype@ declaration syntax.
sortNewtypesC :: [String] -> [(String, [String])]
sortNewtypesC :: [String] -> [(String, [String])]
sortNewtypesC = (String -> (String, [String])) -> [String] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> ([String] -> String
forall a. HasCallStack => [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l, String -> [String]
typeDependencies String
l))
  where typeContents :: String -> [String]
typeContents String
l = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"=" (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
l String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"newtype "
        typeDependencies :: String -> [String]
typeDependencies String
l = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
words) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l

-- Record a datatype and its dependencies. For @newtype@ declaration syntax.
getNewtypes :: [(String, [String])] -> [NewtypeDecl]
getNewtypes :: [(String, [String])] -> [NewtypeDecl]
getNewtypes = ((String, [String]) -> NewtypeDecl)
-> [(String, [String])] -> [NewtypeDecl]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, [String])
l -> NTD {ntdName :: String
ntdName = ShowS
filterName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> String
forall a b. (a, b) -> a
fst (String, [String])
l, ntdContent :: [String]
ntdContent = [String] -> [String]
filterContents ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> [String]
forall a b. (a, b) -> b
snd (String, [String])
l})

-----------------
-- Sorting and filtering for functions that use @type@ syntax
----------------

-- Only accept types defined with "=" syntax (for now).
isType :: [String] -> [String]
isType :: [String] -> [String]
isType = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"=" String
x Bool -> Bool -> Bool
&& String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"type " String
x)

-- Sorts a datatype and its dependencies. For @type@ declaration syntax.
sortTypes :: [String] -> [(String, [String])]
sortTypes :: [String] -> [(String, [String])]
sortTypes = (String -> (String, [String])) -> [String] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> ([String] -> String
forall a. HasCallStack => [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l, [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
typeContents String
l))
  where typeContents :: String -> [String]
typeContents String
l = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
L.splitOn String
"=" (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
l String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"type "

-- Record a datatype and its dependencies. For @type@ declaration syntax.
getTypes :: [(String, [String])] -> [TypeDecl]
getTypes :: [(String, [String])] -> [TypeDecl]
getTypes = ((String, [String]) -> TypeDecl)
-> [(String, [String])] -> [TypeDecl]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, [String])
l -> TD {tdName :: String
tdName = ShowS
filterName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> String
forall a b. (a, b) -> a
fst (String, [String])
l, tdContent :: [String]
tdContent = [String] -> [String]
filterContents ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String, [String]) -> [String]
forall a b. (a, b) -> b
snd (String, [String])
l})

-----------------
-- Ending filter functions
---------------

-- Combines multiple filter functions. For type contents.
filterContents :: [String] -> [String]
filterContents :: [String] -> [String]
filterContents = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
filterName

-- Combines the below three filter functions. For type names.
filterName :: String -> String
filterName :: ShowS
filterName = ShowS
filterPrimeTypes ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
filterQualifiedTypes ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
filterInvalidChars

-- These characters should either not appear in a .dot file (eg. gets rid of list types), or does some extra cleanup that the general sort functions did not catch.
filterInvalidChars :: String -> String
filterInvalidChars :: ShowS
filterInvalidChars = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
invalidChars)
  where
    invalidChars :: String
invalidChars = String
"[]!} (){->,$" --the space being here is kind of a hack (as a result of uncommon type syntax not caught by the above sorters), but it allows the .dot files to compile for now

-- Primes are not legal syntax in .dot files, so replace @'@ with @_@ instead.
filterPrimeTypes :: String -> String
filterPrimeTypes :: ShowS
filterPrimeTypes = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
"\'") (String -> Text
T.pack String
"_") (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- We don't need to know which types are qualified, so just get rid of the extra information.
filterQualifiedTypes :: String -> String
filterQualifiedTypes :: ShowS
filterQualifiedTypes String
l = if Char
'.' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
l then Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
'.' String
l)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
l else String
l -- get rid of types that are made from qualified imports

---------
-- Other helper functions
---------

-- strips leading and trailing whitespace from strings
stripWS :: String -> String
stripWS :: ShowS
stripWS = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack