packages feed

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