Import.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}

module Descript.BasicInj.Data.Import.Import
  ( ImportRecord (..)
  , ImportDecl (..)
  , ImportCtx (..)
  , mkImportRecord
  ) where

import Descript.BasicInj.Data.Import.Module
import Descript.BasicInj.Data.Atom
import Descript.Misc
import Data.Monoid

-- | Imports a single record.
data ImportRecord an
  = ImportRecord
  { importRecordAnn :: an
  , importRecordFrom :: FSymbol an
  , importRecordTo :: FSymbol 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)

-- | Contains all a source's imports.
data ImportCtx an
  = ImportCtx
  { importCtxAnn :: an
  , moduleDecl :: ModuleDecl an
  , importDecls :: [ImportDecl an]
  } deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

instance Ann ImportCtx where
  getAnn = importCtxAnn

instance Ann ImportDecl where
  getAnn = importDeclAnn

instance Ann ImportRecord where
  getAnn = importRecordAnn

instance Printable ImportCtx where
  aprintRec sub (ImportCtx _ mdecl idecls)
    = pintercal "\n" $ filter (/= mempty) $ sub mdecl : map sub idecls

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 $ fsymbol from =@= fsymbol to

  needsFullReprint _pxy = True

instance (Show an) => Summary (ImportCtx an) where
  summaryRec = pprintSummaryRec

instance (Show an) => Summary (ImportDecl an) where
  summaryRec = pprintSummaryRec

instance (Show an) => Summary (ImportRecord an) where
  summaryRec = pprintSummaryRec

-- | If the second param is 'Nothing', makes a record which implicitly
-- imports the symbol as itself.
mkImportRecord :: an -> FSymbol an -> Maybe (FSymbol an) -> ImportRecord an
mkImportRecord _ ft Nothing = ImportRecord (getAnn ft) ft ft
mkImportRecord ann from (Just to) = ImportRecord ann from to