content: -- |
  -- Module      : Minigent.Syntax.Utils.Row
  -- Copyright   : (c) Data61 2018-2019
  --                   Commonwealth Science and Research Organisation (CSIRO)
  --                   ABN 41 687 119 230
  -- License     : BSD3
  --
  -- A grab-bag of functions to manipulate rows, and to combine them and create them
  -- in various ways.
  --
  -- It must be imported qualified to prevent prelude clashes.
  {-# LANGUAGE FlexibleContexts #-}
  module Minigent.Syntax.Utils.Row
    ( -- * Constructors
      fromList
    , incomplete
    , -- * Queries
      entries
    , entriesMap
    , rowTakenEntries
    , rowUntakenEntries
    , compatible
    , null
    , untakenTypes
    , typesFor
    , justVar
    , -- * Manipulating
      mapEntries
    , take
    , put
    , -- * Row Union and Combination
      -- ** Row Union
      union
    , UnionMethod
    , leastTaken
    , mostTaken
    , -- ** Common entries
      common
    , withoutCommon
    ) where
  
  
  import Minigent.Syntax
  import qualified Data.Map as M
  import qualified Data.Set as S
  import qualified Minigent.Fresh as F
  import Prelude hiding (take, null)
  import Data.Maybe (mapMaybe)
  import Control.Monad (guard)
  
  -- | Given a list of entries, produce a complete row without a unification row variable.
  fromList :: [Entry] -> Row
  fromList es = Row (M.fromList (map (\e@(Entry f _ _ )-> (f,e)) es)) Nothing
  
  -- | Given a list of entries, produce an incomplete row with a fresh unification row variable.
  incomplete :: (Monad m, F.MonadFresh VarName m) => [Entry] -> m Row
  incomplete es = do
    u <- F.fresh
    pure ((fromList es) { rowVar = Just u })
  
  -- | Returns those pairs of entries in the input rows that have the same field/constructor
  --   name.
  common :: Row -> Row -> [(Entry, Entry)]
  common r1 r2 = M.elems (M.intersectionWith (,) (rowEntries r1) (rowEntries r2))
  
  -- | Returns whats left of the two input rows when all common entries are removed.
  withoutCommon :: Row -> Row -> (Row, Row)
  withoutCommon (Row e1 v1) (Row e2 v2) = ( Row (e1 `M.withoutKeys` M.keysSet e2) v1
                                          , Row (e2 `M.withoutKeys` M.keysSet e1) v2
                                          )
  
  -- | Given a set of field names, return all the types for those field names in the row.
  typesFor :: S.Set FieldName -> Row -> [Type]
  typesFor fs (Row m _) = map (\(Entry _ t _ ) -> t) (M.elems (M.restrictKeys m fs))
  
  -- | Does a row have no concrete entries and a unification variable, which is effectively an unconstrained unification variable
  justVar :: Row -> Bool
  justVar (Row es (Just _)) = M.null es
  justVar _ = False
  
  -- | Returns true iff the row has no entries and no unification variable.
  null :: Row -> Bool
  null (Row m Nothing) = M.null m
  null _ = False
  
  -- | Returns true iff the two rows could be considered equal after unification.
  compatible :: Row -> Row -> Bool
  compatible (Row m1 Nothing) (Row m2 Nothing) = M.keysSet m1 == M.keysSet m2
  compatible (Row m1 Nothing) (Row m2 (Just _)) = M.keysSet m2 `S.isSubsetOf` M.keysSet m1
  compatible (Row m1 (Just _)) (Row m2 Nothing) = M.keysSet m1 `S.isSubsetOf` M.keysSet m2
  compatible (Row m1 (Just x)) (Row m2 (Just y)) = x /= y || M.keysSet m1 == M.keysSet m2
  
  
  -- | Returns a list of all mappings marked as 'Taken' in the row.
  rowTakenEntries :: Row -> M.Map FieldName Entry
  rowTakenEntries = M.filter (\(Entry _ _ tk) -> tk) . rowEntries
  
  -- | Returns all mappings not marked as 'Taken' in the row.
  rowUntakenEntries :: Row -> M.Map FieldName Entry
  rowUntakenEntries = M.filter (\(Entry _ _ tk) -> not tk) . rowEntries
  
  
  -- | Returns all types not marked as 'Taken' in the row.
  untakenTypes :: Row -> [Type]
  untakenTypes = fmap (\(Entry _ t _) -> t) . M.elems . rowUntakenEntries
  
  -- | Returns all known entries inside the row.
  entries :: Row -> [Entry]
  entries = M.elems . rowEntries
  
  -- | Returns the row entries as a map from variable name to entry:
  entriesMap :: Row -> M.Map VarName Entry
  entriesMap = rowEntries
  
  -- | Manipulate each entry inside a row. It is assumed that the given function
  --   does not change the field or constructor name in the entry. Don't do that.
  mapEntries :: (Entry -> Entry) -> Row -> Row
  mapEntries func (Row m e) = Row (fmap func m) e
  
  -- | Given a field name, mark is as taken in the row (if it exists).
  take :: FieldName -> Row -> Row
  take f (Row m e) = Row (M.adjust (\(Entry f t _) -> Entry f t True) f m) e
  
  -- | Given a field name, unmark is as taken in the row (if it exists).
  put :: FieldName -> Row -> Row
  put f (Row m e) = Row (M.adjust (\(Entry f t _) -> Entry f t False) f m) e
  
  -- | Returns true iff the field is taken in the given row.
  takenIn :: FieldName -> Row -> Bool
  takenIn f (Row m _) = case M.lookup f m of
     Nothing -> False
     Just (Entry _ _ b) -> b
  
  -- | A @UnionMethod@ is a function that, given a particular field/constructor name,
  --   and the two rows in which it may occur, decides whether or not this field should
  --   be marked as taken or not.
  type UnionMethod = (FieldName -> Row -> Row -> Taken)
  
  -- | Given a @UnionMethod@ to determine if a field should be marked as taken or not,
  --   combine two rows into a new one where each type is a fresh unification variable.
  union :: (Monad m, F.MonadFresh VarName m) => UnionMethod -> Row -> Row -> m Row
  union method r1@(Row m1 _) r2@(Row m2 _)= do
    let keys = S.toList (M.keysSet m1 `S.union` M.keysSet m2)
    entries <- mapM (\x -> Entry x . UnifVar <$> F.fresh <*> pure (method x r1 r2)) keys
    incomplete entries
  
  -- | If the field or constructor is taken in all the rows in which it appears, then it
  --   is taken in the union row.
  leastTaken :: UnionMethod
  leastTaken x r1@(Row m1 v1) r2@(Row m2 v2)
    | x `S.member` M.keysSet m1 && x `S.member` M.keysSet m2 = x `takenIn` r1 && x `takenIn` r2
    | x `S.member` M.keysSet m1 = x `takenIn` r1
    | x `S.member` M.keysSet m2 = x `takenIn` r2
    | otherwise                 = False
  
  -- | If the field is taken in any of the rows in which it appears, then the field is taken
  --   in the union row.
  mostTaken :: UnionMethod
  mostTaken x r1@(Row m1 v1) r2@(Row m2 v2)
    | x `S.member` M.keysSet m1 && x `S.member` M.keysSet m2 = x `takenIn` r1 || x `takenIn` r2
    | x `S.member` M.keysSet m1 = x `takenIn` r1
    | x `S.member` M.keysSet m2 = x `takenIn` r2
    | otherwise                 = True
  