{- This file is part of smaoin.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Data.Smaoin
    ( Resource (..)
    , res
    , RealNum ()
    , sig
    , expo
    , realnum
    , Rational (..)
    , Number (..)
    , Value (..)
    , Entity (..)
    , Statement (..)
    , ObjectSection (..)
    , PredicateSection (..)
    , StatementBlock (..)
    , generateUid
    )
where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (fromMaybe)
import Data.Ratio
import Data.String (fromString)
import qualified Data.Text.Lazy as T
import qualified Data.UUID as U
import qualified System.Random as R

-- | A Smaoin resource identifier, also known as a Uid.
--
-- A resource in Smaoin is some idea or object in the broad sense, which can be
-- described using statements, and be related to other resources.
newtype Resource = Resource BS.ByteString deriving (Eq, Show)

instance R.Random Resource where
    randomR (Resource a, Resource b) g = (Resource $ U.toASCIIBytes u, h)
        where
        f r = fromMaybe U.nil (U.fromASCIIBytes r)
        (u, h) = R.randomR (f a, f b) g

    random g = (Resource $ U.toASCIIBytes u, h)
        where
        u :: U.UUID
        (u, h) = R.random g

-- | Shortcut for creating a 'Resource' from a 'String'. The string is simply
-- converted into a byte sequence.
res :: String -> Resource
res = Resource . fromString

-- | Arbitrary precision real number.
--
-- While @RealNum@ is an instance of @Num@, the implementation isn't intended
-- for general math use, and is probably much simpler than what the scientific
-- Haskell packages provide. However, it is certainly suitable for basic
-- manipulations.
data RealNum = RealNum Integer Integer deriving (Eq, Show)

-- | Get the significand of a 'RealNum', i.e. the /s/ in /s * 10^e/
sig :: RealNum -> Integer
sig (RealNum s _) = s

-- | Get the exponent of a 'RealNum', i.e. the /e/ in /s * 10^e/
expo :: RealNum -> Integer
expo (RealNum _ e) = e

-- | Create a 'RealNum'. The first argument is the significand, and the second
-- is an exponent. @realnum s e@ represents the number @s * 10^e@. This
-- representation allows to precisely encode any real number expressed in Idan
-- (excluding rational numbers expressed as ratios).
realnum :: Integer -> Integer -> RealNum
realnum s e = normalize $ RealNum s e

radix :: Integer
radix = 10

normalize :: RealNum -> RealNum
normalize (RealNum s e) = RealNum s' e'
    where
    (s', e') = normalize' s e
    normalize' x y = if x == 0 then (0, 0) else cleanZeros x y
    cleanZeros x y =
        let (d, m) = divMod x radix in
        if m == 0
            then cleanZeros d (y + 1)
            else (x, y)

instance Num RealNum where
    (RealNum s1 e1) + (RealNum s2 e2) = normalize $ RealNum (s1' + s2') e'
        where
        e' = min e1 e2
        s1' = s1 * radix ^ (e1 - e')
        s2' = s2 * radix ^ (e2 - e')

    (RealNum s1 e1) * (RealNum s2 e2) = normalize $ RealNum (s1 * s2) (e1 + e2)

    abs (RealNum s e) = RealNum (abs s) e

    signum (RealNum s e) = RealNum (signum s) 0

    fromInteger i = normalize $ RealNum i 0

    negate (RealNum s e) = RealNum (negate s) e

-- | A Smaoin number can be represented as a real number or as a ratio.
data Number = RealNumber RealNum | RatioNumber Rational deriving (Eq, Show)

-- | A Smaoin value, i.e. an entity with predefined meaning and traits. The
-- type can be specified statically through a dedicated data constructor, or
-- generically as a resource.
data Value = Boolean Bool
           | Number Number
           | Character Char
           | String T.Text
           | Chunk BL.ByteString
           | Generic T.Text Resource
           deriving (Eq, Show)

-- | A Smaoin entity. It is the atomic concept in Smaoin: Everything is an
-- entity. An entity can be described (resource) or predefined (value).
data Entity = ResourceE Resource | ValueE Value deriving (Eq, Show)

-- | Statements can be grouped in lists and containers to form simple
-- in-memory datastores, query results and so on.
--
-- Parameters are: Identifier, subject, predicate, object.
data Statement = Statement Resource Resource Resource Entity
    deriving (Eq, Show)

-- An object section is attached to subjects and predicated to form
-- statements. It contains the object of a statement, and the identifier that
-- the resulting statement would have, once attached to a subject and a
-- predicate.
--
-- Parameters are: Object, identifier.
data ObjectSection = ObjectSection Entity Resource deriving Show

-- | A predicate section is meant to be attached to a subject. It describes it
-- through one or more statements. It expresses predicate-object-identifier
-- triples. But instead of repeating predicates, it gives each predicate its
-- own set of object-identifier pairs.
--
-- Parameters: Predicate; Objects and identifiers.
data PredicateSection = PredicateSection Resource [ObjectSection] deriving Show

-- | A statement block describes a single subject, by expressing one or more
-- statements which share that subject. The predicate sections contain the
-- predicates, objects and identifiers. With the subject attached, they form
-- statements. Statement blocks can be grouped in lists and countainers to form
-- simple in-memory datastores, query results and so on.
--
-- Parameters: 1) Subject; 2) Predicates, objects, identifiers.
data StatementBlock = StatementBlock Resource [PredicateSection] deriving Show

-- | Create a fresh new Uid. It is randomly generated, using the global random
-- generator. 'Resource' is a 'R.Random' instance, so you can use any other
-- random generator.
generateUid :: IO Resource
generateUid = R.randomIO