descript-lang-0.2.0.0: src/Descript/Free/Data/Import/Import.hs
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
module Descript.Free.Data.Import.Import
( ImportRecord (..)
, ImportDecl (..)
, mkImportDecl
, mkImportRecord
) where
import Descript.Free.Data.Import.Module
import Descript.Free.Data.Atom
import Descript.Misc
import Data.Monoid
import Data.Maybe
-- | Imports a single record.
data ImportRecord an
= ImportRecord
{ importRecordAnn :: an
, importRecordFrom :: Symbol an
, importRecordTo :: Symbol an
} deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)
-- | An import declaration.
data ImportDecl an
= ImportDecl
{ importDeclAnn :: an
, importDeclPath :: ModulePath an
-- | Moves records in the dependency into this module.
, importDeclSrcImports :: [ImportRecord an]
-- | Moves records in this module into the dependency.
, importDeclDstImports :: [ImportRecord an]
} deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)
instance Ann ImportDecl where
getAnn = importDeclAnn
instance Ann ImportRecord where
getAnn = importRecordAnn
instance Printable ImportDecl where
aprintRec sub (ImportDecl _ path isrcs idsts)
= "import "
<> sub path
<> pimp1 ("[" <> pintercal ", " (map sub isrcs) <> "]")
<> pimp2 ("{" <> pintercal ", " (map sub idsts) <> "}")
where pimp1 = pimpIf $ null isrcs
pimp2 = pimpIf $ null idsts
instance Printable ImportRecord where
aprintRec sub (ImportRecord _ from to)
= pimp' (sub from <> " => ") <> sub to
where pimp' = pimpIf $ from =@= to
needsFullReprint _pxy = True
instance (Show an) => Summary (ImportDecl an) where
summaryRec = pprintSummaryRec
instance (Show an) => Summary (ImportRecord an) where
summaryRec = pprintSummaryRec
-- | If 'Nothing' is given as parameters/imports, creates a declaration
-- without any parameters/imports.
mkImportDecl :: an
-> ModulePath an
-> Maybe [ImportRecord an]
-> Maybe [ImportRecord an]
-> ImportDecl an
mkImportDecl ann path misrcs midsts = ImportDecl ann path isrcs idsts
where isrcs = [] `fromMaybe` misrcs
idsts = [] `fromMaybe` midsts
-- | If the second param is 'Nothing', makes a record which implicitly
-- imports (or passes, if a parameter) the symbol as itself.
mkImportRecord :: (TaintAnn an)
=> an
-> Symbol an
-> Maybe (Symbol an)
-> ImportRecord an
mkImportRecord _ ft Nothing = ImportRecord ann ft ft
where ann = getAnn ft
mkImportRecord ann from (Just to) = ImportRecord ann from to