lcc/Hcompta/LCC/Chart/Test.hs

   1 module Chart.Test where
   2
   3 import Test.Tasty
   4 import Test.Tasty.HUnit
   5
   6 import Control.Monad (join)
   7 import Data.Bool
   8 import Data.Char (Char)
   9 import Data.Either (Either(..))
  10 import Data.Function (($), (.))
  11 import Data.Functor ((<$>))
  12 import Data.NonNull (NonNull)
  13 import Data.Proxy
  14 import Data.Text (Text)
  15 import Data.TreeMap.Strict.Zipper
  16 import Data.Tuple (fst)
  17 import System.FilePath.Posix ((</>))
  18 import System.IO (IO, FilePath)
  19 import qualified Data.NonNull as NonNull
  20 import qualified System.Directory as IO
  21 import qualified System.IO.Memoize as IO
  22 import qualified Text.Megaparsec as P
  23 -- import Control.Applicative (Applicative(..))
  24 -- import Control.Monad.IO.Class (MonadIO(..))
  25 -- import Data.Functor.Identity (Identity(..))
  26 -- import Data.Maybe (isJust)
  27 -- import Prelude (error)
  28 -- import Text.Show (show)
  29 -- import qualified Data.List as List
  30 -- import qualified Data.Map.Strict as Map
  31 -- import qualified Data.Strict as S
  32 -- import qualified Data.Text as Text
  33 -- import qualified Data.Text.IO as Text.IO
  34 -- import qualified Data.TreeMap.Strict as TreeMap
  35
  36 -- import qualified Hcompta as H
  37 import qualified Hcompta.LCC as LCC
  38 import qualified Hcompta.LCC.Sym ()
  39 import qualified Language.Symantic as Sym
  40 import qualified Language.Symantic.Lib ()
  41
  42 type Ifaces = '[Proxy (->), Proxy LCC.Quantity]
  43
  44 chart_from_file :: FilePath -> IO (Either (P.ParseError Char P.Dec) LCC.Chart)
  45 chart_from_file file = do
  46         cwd <- IO.getCurrentDirectory
  47         (fst . fst <$>) $ -- NOTE: drop final contexts.
  48                 LCC.read_file (cwd </> file) $
  49                         LCC.read @Ifaces @[LCC.Transaction] $
  50                                 LCC.g_get $ (\_j chart -> chart) <$> -- NOTE: get Chart from final context.
  51                                 LCC.g_journal
  52                                  @(Sym.TyConsts_of_Ifaces Ifaces)
  53                                  @Ifaces
  54                                  @[LCC.Transaction]
  55                                  (:)
  56
  57 chart_00 :: (FilePath, IO (Either (P.ParseError Char P.Dec) LCC.Chart))
  58 chart_00 = (file,) $ join $ IO.once $ chart_from_file file
  59         where file = "Hcompta/LCC/Chart/chart.00.lcc"
  60 chart_01 :: (FilePath, IO (Either (P.ParseError Char P.Dec) LCC.Chart))
  61 chart_01 = (file,) $ join $ IO.once $ chart_from_file file
  62         where file = "Hcompta/LCC/Chart/chart.01.lcc"
  63
  64 tag_path :: [Text] -> LCC.Tag_Path
  65 tag_path p = LCC.Tag_Path $ NonNull.impureNonNull (LCC.Name <$> p)
  66
  67 zip_path :: [Text] -> NonNull [LCC.Name]
  68 zip_path p = NonNull.impureNonNull (LCC.Name <$> p)
  69
  70 tests :: TestTree
  71 tests = testGroup "Chart"
  72  [ testGroup "chart_axis_child" $
  73         let (==>) (file, input) expected =
  74                 testCase file $ do
  75                         lr_chart <- input
  76                         let path = do
  77                                 chart <- lr_chart
  78                                 let sel = zipper_child
  79                                 let res = sel $ LCC.zipper_chart chart
  80                                 Right $ (LCC.unName <$>) . path_of_zipper <$> res
  81                         path @?= Right expected in
  82          [ chart_00 ==>
  83                  [ ["1.Capital"]
  84                  , ["2.Immobilisation"]
  85                  , ["3.Stock"]
  86                  , ["4.Tiers"]
  87                  , ["5.Finance"]
  88                  , ["6.Charge"]
  89                  , ["7.Produit"]
  90                  ]
  91          ]
  92  , testGroup "chart_axis_descendant" $
  93         let (==>) (file, input) expected =
  94                 testCase file $ do
  95                         lr_chart <- input
  96                         let path = do
  97                                 chart <- lr_chart
  98                                 let sel = zipper_descendant
  99                                 let res = sel $ LCC.zipper_chart chart
 100                                 Right $ (LCC.unName <$>) . path_of_zipper <$> res
 101                         path @?= Right expected in
 102          [ chart_00 ==>
 103                  [ ["1.Capital"]
 104                  , ["2.Immobilisation"]
 105                  , ["3.Stock"]
 106                  , ["4.Tiers"]
 107                  , ["4.Tiers", "0.Fournisseur"]
 108                  , ["4.Tiers", "0.Fournisseur", "9.Débiteur"]
 109                  , ["4.Tiers", "1.Client"]
 110                  , ["4.Tiers", "2.Personnel"]
 111                  , ["4.Tiers", "3.Sécu"]
 112                  , ["4.Tiers", "4.État"]
 113                  , ["5.Finance"]
 114                  , ["5.Finance", "1.Établissement"]
 115                  , ["5.Finance", "1.Établissement", "2.Banque"]
 116                  , ["5.Finance", "3.Caisse"]
 117                  , ["6.Charge"]
 118                  , ["7.Produit"]
 119                  ]
 120          ]
 121  , testGroup "zipper_account_tags" $
 122         let (==>) (file, input) expected =
 123                 testCase file $ do
 124                         lr_chart <- input
 125                         let path = do
 126                                 chart <- lr_chart
 127                                 let sel =
 128                                  -- //*[...[~Bilan][0][~Bilan:Actif]]
 129                                         zipper_descendant
 130                                         `zipper_filter` not . zipper_null
 131                                          (zipper_ancestor_or_self
 132                                                 `zipper_filter` not . zipper_null
 133                                                  (zipper_child_lookup $ LCC.Name "Bilan")
 134                                                  . LCC.zipper_accounts_tags
 135                                                 `zipper_at` 0
 136                                                 `zipper_filter` not . zipper_null
 137                                                  (zipper_child_lookups $ zip_path ["Bilan", "Actif"])
 138                                                  . LCC.zipper_accounts_tags)
 139                                 let res = sel $ zipper $ LCC.chart_accounts chart
 140                                 Right $ (LCC.unName <$>) . path_of_zipper <$> res
 141                         path @?= Right expected in
 142          [ chart_00 ==>
 143                  [ ["2.Immobilisation"]
 144                  , ["4.Tiers","0.Fournisseur","9.Débiteur"]
 145                  , ["4.Tiers","1.Client"]
 146                  , ["4.Tiers","3.Sécu"]
 147                  ]
 148          ]
 149  ]