CodeBuilderSpec.hs

{-# LANGUAGE OverloadedLists, TypeFamilies #-}
module Nirum.CodeBuilderSpec where

import Control.Monad (forM_)
import Data.Map.Strict as M
import qualified Data.SemVer as SV
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B
import Test.Hspec.Meta
import qualified Text.PrettyPrint as P

import Nirum.CodeBuilder
import qualified Nirum.Constructs.DeclarationSet as DS
import Nirum.Constructs.Module (Module (..))
import Nirum.Constructs.ModulePath (ModulePath (..))
import qualified Nirum.Constructs.TypeDeclaration as TD
import Nirum.Package.Metadata (Metadata (..), Package (..), Target (..))
import qualified Nirum.Package.ModuleSet as MS
import Nirum.TypeInstance.BoundModule hiding (lookupType)


emptyModule :: Module
emptyModule = Module { types = DS.empty, docs = Nothing }

modules' :: MS.ModuleSet
modules' = case m of
    Right m' -> m'
    _ -> error "unreachable"
  where
    m = MS.fromList [ (["fruits"], emptyModule)
                    , (["imported-commons"], emptyModule)
                    , (["transports", "truck"], emptyModule)
                    , (["transports", "container"], emptyModule)
                    ]

package :: Package DummyTarget
package = Package { metadata = Metadata { version = SV.version 0 0 1 [] []
                                        , authors = []
                                        , description = Nothing
                                        , license = Nothing
                                        , keywords = []
                                        , target = DummyTarget
                                        }
                  , modules = modules'
                  }

run :: CodeBuilder DummyTarget () a -> L.Text
run = B.toLazyText . snd . runBuilder package ["fruits"] ()


spec = do
    specify "writeLine" $ do
        let w = do
                writeLine "a"
                writeLine "b"
        run w `shouldBe` "a\nb\n"
    specify "writeLine 2" $ do
        let w = forM_ ([1 .. 10] :: [Integer]) $ \ i ->
                    writeLine $ P.text $ show i
        run w `shouldBe` "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n"
    describe "nest" $ do
        it "should indent its own context" $ do
            let w = do
                    writeLine "a"
                    nest 4 $ writeLine "b"
            run w `shouldBe` "a\n    b\n"
        it "should indent its own context (2)" $ do
            let w = do
                    writeLine "a"
                    nest 4 $ do
                        writeLine "b"
                        writeLine "cd"
                    writeLine "eee"
            run w `shouldBe` "a\n    b\n    cd\neee\n"
    describe "lookupType" $
        specify "primitives" $ do
            let run' = fst . runBuilder package ["fruits"] ()
            let core = ModuleName "core"
            run' (lookupType "text") `shouldBe`
                Imported core "text" (TD.PrimitiveType TD.Text TD.String)
            run' (lookupType "int32") `shouldBe`
                Imported core "int32" (TD.PrimitiveType TD.Int32 TD.Number)


data DummyTarget = DummyTarget deriving (Eq, Ord, Show)

instance Target DummyTarget where
    type CompileResult DummyTarget = T.Text
    type CompileError DummyTarget = T.Text
    targetName _ = "dummy"
    parseTarget _ = return DummyTarget
    compilePackage _ = M.empty
    showCompileError _ e = e
    toByteString _ = encodeUtf8