--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Datatype
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2018 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  H98
--
--  This module defines the structures used by Swish to represent and
--  manipulate RDF datatypes.
--
--------------------------------------------------------------------------------

module Swish.RDF.Datatype
    ( RDFDatatype
    , RDFDatatypeVal
    , RDFDatatypeMod
    , RDFModifierFn, RDFApplyModifier
    , makeRdfDtOpenVarBindingModify, makeRdfDtOpenVarBindingModifiers
    , applyRDFDatatypeMod
    , RDFDatatypeSub
    , fromRDFLabel, toRDFLabel, makeDatatypedLiteral
    )
where

import Swish.Datatype
    ( Datatype
    , DatatypeVal(..)
    , DatatypeMap(..)
    , DatatypeMod(..), ModifierFn
    , ApplyModifier
    , DatatypeSub(..)
    )
import Swish.Namespace (ScopedName)
import Swish.VarBinding (VarBindingModify(..))

import Swish.RDF.Graph
    ( RDFLabel(..)
    , isDatatyped
    , getLiteralText
    , RDFGraph
    )

import Swish.RDF.VarBinding (RDFVarBinding, RDFOpenVarBindingModify)

import Data.Maybe (fromMaybe, isJust, fromJust)

import qualified Data.Text as T

------------------------------------------------------------
--  Specialize datatype framework types for use with RDF
------------------------------------------------------------

-- |RDF datatype wrapper used with RDF graph values
--
type RDFDatatype = Datatype RDFGraph RDFLabel RDFLabel

-- |RDF datatype value used with RDF graph values
--
type RDFDatatypeVal vt = DatatypeVal RDFGraph vt RDFLabel RDFLabel

-- |RDF datatype modifier used with RDF graph values
--
type RDFDatatypeMod vt = DatatypeMod vt RDFLabel RDFLabel

-- |Describe a subtype/supertype relationship between a pair
--  of RDF datatypes.
--
type RDFDatatypeSub supvt subvt = DatatypeSub RDFGraph RDFLabel RDFLabel supvt subvt

-- |RDF value modifier function type
--
--  This indicates a modifier function that operates on 'RDFLabel' values.
--
type RDFModifierFn = ModifierFn RDFLabel

-- |RDF value modifier application function type
--
--  This indicates a function that applies RDFModifierFn functions.
--
type RDFApplyModifier = ApplyModifier RDFLabel RDFLabel

--------------------------------------------------------------
--  Functions for creating datatype variable binding modifiers
--------------------------------------------------------------

-- |Create an 'RDFOpenVarBindingModify' value.
--
--  The key purpose of this function is to lift the supplied
--  variable constraint functions from operating on data values directly
--  to a corresponding list of functions that operate on values contained
--  in RDF graph labels (i.e. RDF literal nodes).  It also applies
--  node type checking, such that if the actual RDF nodes supplied do
--  not contain appropriate values then the variable binding is not
--  accepted.
--
makeRdfDtOpenVarBindingModify ::
    RDFDatatypeVal vt
    -- ^ is an 'RDFDatatype' value containing details of the datatype
    --   for which a variable binding modifier is created.
    -> RDFDatatypeMod vt 
    -- ^ is the data value modifier value that defines the calculations
    --   that are used to implement a variable binding modifier.
    -> RDFOpenVarBindingModify
makeRdfDtOpenVarBindingModify :: forall vt.
RDFDatatypeVal vt -> RDFDatatypeMod vt -> RDFOpenVarBindingModify
makeRdfDtOpenVarBindingModify RDFDatatypeVal vt
dtval RDFDatatypeMod vt
dtmod =
    RDFDatatypeMod vt -> ApplyModifier RDFLabel RDFLabel
forall vt lb vn. DatatypeMod vt lb vn -> ApplyModifier lb vn
dmAppf RDFDatatypeMod vt
dtmod (RDFDatatypeMod vt -> ScopedName
forall vt lb vn. DatatypeMod vt lb vn -> ScopedName
dmName RDFDatatypeMod vt
dtmod) ([ModifierFn RDFLabel] -> RDFOpenVarBindingModify)
-> [ModifierFn RDFLabel] -> RDFOpenVarBindingModify
forall a b. (a -> b) -> a -> b
$ (ModifierFn vt -> ModifierFn RDFLabel)
-> [ModifierFn vt] -> [ModifierFn RDFLabel]
forall a b. (a -> b) -> [a] -> [b]
map (RDFDatatypeVal vt -> ModifierFn vt -> ModifierFn RDFLabel
forall vt.
RDFDatatypeVal vt -> ModifierFn vt -> ModifierFn RDFLabel
makeRDFModifierFn RDFDatatypeVal vt
dtval) (RDFDatatypeMod vt -> [ModifierFn vt]
forall vt lb vn. DatatypeMod vt lb vn -> [ModifierFn vt]
dmModf RDFDatatypeMod vt
dtmod)

-- |Create all RDFOpenVarBindingModify values for a given datatype value.
--  See 'makeRdfDtOpenVarBindingModify'.
--
makeRdfDtOpenVarBindingModifiers ::
    RDFDatatypeVal vt 
    -- ^  is an 'RDFDatatype' value containing details of the datatype
    --    for which variable binding modifiers are created.
    -> [RDFOpenVarBindingModify]
makeRdfDtOpenVarBindingModifiers :: forall vt. RDFDatatypeVal vt -> [RDFOpenVarBindingModify]
makeRdfDtOpenVarBindingModifiers RDFDatatypeVal vt
dtval =
    (RDFDatatypeMod vt -> RDFOpenVarBindingModify)
-> [RDFDatatypeMod vt] -> [RDFOpenVarBindingModify]
forall a b. (a -> b) -> [a] -> [b]
map (RDFDatatypeVal vt -> RDFDatatypeMod vt -> RDFOpenVarBindingModify
forall vt.
RDFDatatypeVal vt -> RDFDatatypeMod vt -> RDFOpenVarBindingModify
makeRdfDtOpenVarBindingModify RDFDatatypeVal vt
dtval) (RDFDatatypeVal vt -> [RDFDatatypeMod vt]
forall ex vt lb vn.
DatatypeVal ex vt lb vn -> [DatatypeMod vt lb vn]
tvalMod RDFDatatypeVal vt
dtval)

-- |Apply a datatype modifier using supplied RDF labels to a supplied
--  RDF variable binding.
--
applyRDFDatatypeMod ::
    RDFDatatypeVal vt -> RDFDatatypeMod vt -> [RDFLabel] -> [RDFVarBinding]
    -> [RDFVarBinding]
applyRDFDatatypeMod :: forall vt.
RDFDatatypeVal vt
-> RDFDatatypeMod vt
-> [RDFLabel]
-> [RDFVarBinding]
-> [RDFVarBinding]
applyRDFDatatypeMod RDFDatatypeVal vt
dtval RDFDatatypeMod vt
dtmod [RDFLabel]
lbs =
    VarBindingModify RDFLabel RDFLabel
-> [RDFVarBinding] -> [RDFVarBinding]
forall a b.
VarBindingModify a b -> [VarBinding a b] -> [VarBinding a b]
vbmApply (RDFDatatypeVal vt -> RDFDatatypeMod vt -> RDFOpenVarBindingModify
forall vt.
RDFDatatypeVal vt -> RDFDatatypeMod vt -> RDFOpenVarBindingModify
makeRdfDtOpenVarBindingModify RDFDatatypeVal vt
dtval RDFDatatypeMod vt
dtmod [RDFLabel]
lbs)

-- |Given details of a datatype and a single value constraint function,
--  return a new constraint function that operates on 'RDFLabel' values.
--
--  The returned constraint function incorporates checks for appropriately
--  typed literal nodes, and returns similarly typed literal nodes.
--
makeRDFModifierFn ::
    RDFDatatypeVal vt -> ModifierFn vt -> RDFModifierFn
makeRDFModifierFn :: forall vt.
RDFDatatypeVal vt -> ModifierFn vt -> ModifierFn RDFLabel
makeRDFModifierFn RDFDatatypeVal vt
dtval ModifierFn vt
fn [RDFLabel]
ivs =
    let
        ivals :: Maybe [vt]
ivals = (RDFLabel -> Maybe vt) -> [RDFLabel] -> Maybe [vt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (RDFDatatypeVal vt -> RDFLabel -> Maybe vt
forall vt. RDFDatatypeVal vt -> RDFLabel -> Maybe vt
fromRDFLabel RDFDatatypeVal vt
dtval) [RDFLabel]
ivs
        ovals :: [vt]
ovals | Maybe [vt] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [vt]
ivals = ModifierFn vt
fn (Maybe [vt] -> [vt]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [vt]
ivals)
              | Bool
otherwise    = []
    in
        [RDFLabel] -> Maybe [RDFLabel] -> [RDFLabel]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [RDFLabel] -> [RDFLabel]) -> Maybe [RDFLabel] -> [RDFLabel]
forall a b. (a -> b) -> a -> b
$ (vt -> Maybe RDFLabel) -> [vt] -> Maybe [RDFLabel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (RDFDatatypeVal vt -> vt -> Maybe RDFLabel
forall vt. RDFDatatypeVal vt -> vt -> Maybe RDFLabel
toRDFLabel RDFDatatypeVal vt
dtval) [vt]
ovals

------------------------------------------------------------
--  Helpers to map between datatype values and RDFLabels
------------------------------------------------------------

-- | Convert from a typed literal to a Haskell value,
-- with the possibility of failure.
fromRDFLabel ::
    RDFDatatypeVal vt -> RDFLabel -> Maybe vt
fromRDFLabel :: forall vt. RDFDatatypeVal vt -> RDFLabel -> Maybe vt
fromRDFLabel RDFDatatypeVal vt
dtv RDFLabel
lab
    | ScopedName -> RDFLabel -> Bool
isDatatyped ScopedName
dtnam RDFLabel
lab = DatatypeMap vt -> Text -> Maybe vt
forall vt. DatatypeMap vt -> Text -> Maybe vt
mapL2V DatatypeMap vt
dtmap (Text -> Maybe vt) -> Text -> Maybe vt
forall a b. (a -> b) -> a -> b
$ RDFLabel -> Text
getLiteralText RDFLabel
lab
    | Bool
otherwise             = Maybe vt
forall a. Maybe a
Nothing
    where
        dtnam :: ScopedName
dtnam = RDFDatatypeVal vt -> ScopedName
forall ex vt lb vn. DatatypeVal ex vt lb vn -> ScopedName
tvalName RDFDatatypeVal vt
dtv
        dtmap :: DatatypeMap vt
dtmap = RDFDatatypeVal vt -> DatatypeMap vt
forall ex vt lb vn. DatatypeVal ex vt lb vn -> DatatypeMap vt
tvalMap RDFDatatypeVal vt
dtv

-- | Convert a Haskell value to a typed literal (label),
-- with the possibility of failure.
toRDFLabel :: RDFDatatypeVal vt -> vt -> Maybe RDFLabel
toRDFLabel :: forall vt. RDFDatatypeVal vt -> vt -> Maybe RDFLabel
toRDFLabel RDFDatatypeVal vt
dtv =
    (Text -> RDFLabel) -> Maybe Text -> Maybe RDFLabel
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScopedName -> Text -> RDFLabel
makeDatatypedLiteral ScopedName
dtnam) (Maybe Text -> Maybe RDFLabel)
-> (vt -> Maybe Text) -> vt -> Maybe RDFLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatatypeMap vt -> vt -> Maybe Text
forall vt. DatatypeMap vt -> vt -> Maybe Text
mapV2L DatatypeMap vt
dtmap
    where
        dtnam :: ScopedName
dtnam = RDFDatatypeVal vt -> ScopedName
forall ex vt lb vn. DatatypeVal ex vt lb vn -> ScopedName
tvalName RDFDatatypeVal vt
dtv
        dtmap :: DatatypeMap vt
dtmap = RDFDatatypeVal vt -> DatatypeMap vt
forall ex vt lb vn. DatatypeVal ex vt lb vn -> DatatypeMap vt
tvalMap RDFDatatypeVal vt
dtv

-- | Create a typed literal. No conversion is made to the
-- string representation.
makeDatatypedLiteral :: 
    ScopedName   -- ^ data type
    -> T.Text    -- ^ string form of the value
    -> RDFLabel
makeDatatypedLiteral :: ScopedName -> Text -> RDFLabel
makeDatatypedLiteral = (Text -> ScopedName -> RDFLabel) -> ScopedName -> Text -> RDFLabel
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> ScopedName -> RDFLabel
TypedLit

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2018 Douglas Burke
--  All rights reserved.
--
--  This file is part of Swish.
--
--  Swish is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  Swish is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with Swish; if not, write to:
--    The Free Software Foundation, Inc.,
--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--------------------------------------------------------------------------------